Initial commit

1 files changed, 266 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/conlib/conop3.f b/sys/gio/ncarutil/conlib/conop3.f
new file mode 100644
index 00000000..e4632478
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conop3.f
@@ -0,0 +1,266 @@
+      SUBROUTINE CONOP3 (IOPT,ARRAY,ISIZE)
+C                                                                               
+C +-----------------------------------------------------------------+           
+C |                                                                 |           
+C |                Copyright (C) 1986 by UCAR                       |           
+C |        University Corporation for Atmospheric Research          |           
+C |                    All Rights Reserved                          |           
+C |                                                                 |           
+C |                 NCARGRAPHICS  Version 1.00                      |           
+C |                                                                 |           
+C +-----------------------------------------------------------------+           
+C                                                                               
+C                                                                               
+C
+C SET THE CONTRAN OPTIONS
+C
+C INPUT
+C     IOPT-CHARACTER STRING OF OPTION VALUE
+C     ARRAY-   REAL ARRAY OF DIMENSION ISIZE
+C     ISIZE-   SIZE OF ARRAY
+C
+C  SET COMMON DATA EQUAL TO INPUT DATA
+C
+C
+C
+      COMMON /CONRA1/ CL(30)     ,NCL        ,OLDZ       ,PV(210)    ,
+     1                FINC       ,HI         ,FLO
+      COMMON /CONRA2/ REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                ISCALE     ,LOOK       ,PLDVLS     ,GRD        ,
+     2                CINC       ,CHILO      ,CON        ,LABON      ,
+     3                PMIMX      ,SCALE      ,FRADV      ,EXTRI      ,
+     4                BPSIZ      ,LISTOP
+      COMMON /CONRA3/ IREC
+      COMMON /CONRA4/ NCP        ,NCPSZ
+      COMMON /CONRA5/ NIT        ,ITIPV
+      COMMON /CONRA6/ XST        ,YST        ,XED        ,YED        ,
+     1                STPSZ      ,IGRAD      ,IG         ,XRG        ,
+     2                YRG        ,BORD       ,PXST       ,PYST       ,
+     3                PXED       ,PYED       ,ITICK
+      COMMON /CONRA7/ TITLE      ,ICNT   ,ITLSIZ
+      COMMON /CONRA8/ IHIGH      ,INMAJ      ,INLAB      ,INDAT      ,
+     1              LEN      ,IFMT       ,LEND       ,
+     2                IFMTD      ,ISIZEP     ,INMIN
+      COMMON /CONRA9/ ICOORD(500),NP         ,MXXY       ,TR         ,
+     1                BR         ,TL         ,BL         ,CONV       ,
+     2                XN         ,YN         ,ITLL       ,IBLL       ,
+     3                ITRL       ,IBRL       ,XC         ,YC         ,
+     4                ITLOC(210) ,JX         ,JY         ,ILOC       ,
+     5                ISHFCT     ,XO         ,YO         ,IOC        ,NC
+      COMMON /CONR10/ NT         ,NL         ,NTNL       ,JWIPT      ,
+     1                JWIWL      ,JWIWP      ,JWIPL      ,IPR        ,
+     2                ITPV
+      COMMON /CONR11/ NREP       ,NCRT       ,ISIZEL     ,
+     1                MINGAP     ,ISIZEM         ,
+     2                TENS
+      COMMON /CONR12/ IXMAX      ,IYMAX      ,XMAX       ,YMAX
+      LOGICAL         REPEAT     ,EXTRAP     ,PER        ,MESS       ,
+     1                LOOK       ,PLDVLS     ,GRD        ,LABON      ,
+     2                PMIMX      ,FRADV      ,EXTRI      ,CINC       ,
+     3                TITLE      ,LISTOP     ,CHILO      ,CON
+      COMMON /CONR13/XVS(50),YVS(50),ICOUNT,SPVAL,SHIELD,
+     1               SLDPLT
+      LOGICAL SHIELD,SLDPLT
+      COMMON /CONR14/LINEAR
+      LOGICAL LINEAR
+      COMMON /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+C
+C  INTPR IS THE DASH PACKAGE COMMON BLOCK INTERFACE
+C  NP11 IS NP IN ALL OTHER INTPR DEFINITIONS; NAME CHANGE BECAUSE OF
+C  CONFLICT
+C
+      COMMON /INTPR/  IPAU       ,FPART      ,TENSN      ,NP11       ,
+     1                SMALL      ,L1         ,ADDLR      ,ADDTB      ,
+     2                MLLINE     ,ICLOSE
+        DIMENSION ARRAY(ISIZE)
+        CHARACTER*7  IOPT
+        CHARACTER*2  TAG, OPT
+C
+C
+        SAVE
+C
+C +NOAO - initialize block data before changing any values
+        call conbdn
+c -NOAO
+C  DETERMINE THE OPTION DESIRED
+C
+      TAG = IOPT(1:2)
+        IF (IOPT(3:3) .EQ. '=') THEN
+            OPT = IOPT(4:5)
+        ELSE
+            OPT = IOPT(5:6)
+        ENDIF
+C
+C  CON CONTOUR LEVELS  CHECK VALUE OF SWITCH
+C
+      IF (TAG .EQ. 'CO') THEN
+C
+C  SWITCH = ON SET CONTOUR LEVELS
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CHILO .OR. CINC) GOTO  140
+C
+C  TEST IF NUMBER OF CONTOURS IS ACCEPTABLE
+C
+              IF (ISIZE .GT. 30)
+     1    CALL SETER (' CONOP3-NUMBER OF CONTOUR LEVELS EXCEEDS 30',
+     2                 1,1)
+      DO  200 I=1,ISIZE
+       CL(I) = ARRAY(I)
+  200 CONTINUE
+      CON = .TRUE.
+      NCL = ISIZE
+      RETURN
+C
+C  SWITCH = OFF CLEAR CONTOUR LEVEL ARRAY (PROGRAM SELECTS)
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+              CON = .FALSE.
+              RETURN
+            ELSE
+                  GOTO 120
+          ENDIF
+C
+C  CONTOUR HI LO OPTION FOUND GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CH') THEN
+C
+C  SWITCH ON SET HI AND FLO
+C
+            IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+                  HI = ARRAY(1)
+                  FLO = ARRAY(2)
+                  CHILO = .TRUE.
+                  RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                CHILO = .FALSE.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  CONTOUR INCREMENT OPTION GET VALUE OF SWITCH
+C
+      ELSEIF (TAG .EQ. 'CI') THEN
+C
+C  SWITCH ON SET INCREMENT
+C
+          IF (OPT .EQ. 'ON') THEN
+              IF (CON) GOTO  140
+              CINC = .TRUE.
+              FINC = ARRAY(1)
+              RETURN
+C
+C  SWITCH OFF CLEAR FLAG
+C
+          ELSEIF (OPT .EQ. 'OF') THEN
+              CINC = .FALSE.
+              RETURN
+        ELSE
+                GOTO 120
+          ENDIF
+C
+C  SCALE THE DATA PLOTTED ON THE CONTOURS AND MIN MAX POINTS
+C
+      ELSEIF (TAG .EQ. 'SD') THEN
+C
+C  SWTICH ON GET SCALE FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                SCALE = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET FOR NO SCALING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                SCALE = 1.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SET THE TENSION VALUE FOR SMOOTHING
+C
+      ELSEIF (TAG .EQ. 'TE') THEN
+C
+C  SWTICH ON SET TENSION FACTOR
+C
+            IF (OPT .EQ. 'ON') THEN
+                TENSN = ARRAY(1)
+                RETURN
+C
+C  SWTICH OFF SET TO DEFAULT TENSION
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                TENSN = TENS
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  DASH PATTERN BREAK POINT SWITCH
+C
+      ELSEIF (TAG .EQ. 'DB') THEN
+C
+C  SWITCH ON GET USERS BREAKPOINT
+C
+            IF (OPT .EQ. 'ON') THEN
+                BPSIZ = ARRAY(1)
+                RETURN
+C
+C  SWITCH OFF SET TO DEFAULT
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                BPSIZ = 0.
+                RETURN
+          ELSE
+                  GOTO 120
+            ENDIF
+C
+C  SHIELD OPTION
+C
+        ELSEIF (TAG .EQ. 'SL') THEN
+C
+C  TURN SHIELDING ON AND SET THE SHIELD COORD POINTERS
+C
+            IF (OPT .EQ. 'ON') THEN
+                  NISIZE = ISIZE/2
+                  CALL CONSSD(ARRAY(1),ARRAY(NISIZE+1),NISIZE)
+                  RETURN
+C
+C  DEACTIVATE SHIELDING
+C
+            ELSEIF (OPT .EQ. 'OF') THEN
+                  ICOUNT = 0
+                  SHIELD = .FALSE.
+                  RETURN
+            ELSE
+                  GOTO 120
+            ENDIF
+        ELSE
+            GOTO 120
+        ENDIF
+C
+C  ERROR UNDEFINED OPTION DETECTED
+C
+  120 CALL SETER (' CONOP3-UNDEFINED OPTION',1,1)
+      RETURN
+C
+C  ILLEGAL USE OF CON WITH CIL OR CHL
+C
+  140 CALL SETER
+     1('CONOP3-ILLEGAL USE OF CON OPTION WITH CIL OR CHL OPTION',
+     2 1,1)
+      RETURN
+        END