Initial commit

1 files changed, 194 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/conlib/conlod.f b/sys/gio/ncarutil/conlib/conlod.f
new file mode 100644
index 00000000..d7fc3804
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conlod.f
@@ -0,0 +1,194 @@
+      SUBROUTINE CONLOD (XD,YD,ZD,NDP,WK,IWK,SCRARR)
+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******************************************************************
+C*                                                                *
+C*   THIS FILE IS A PACKAGE OF SUPPORT ROUTINES FOR THE ULIB      *
+C*   FILES CONRAN AND CONRAS.  SEE THOSE FILES FOR AN             *
+C*   EXPLAINATION OF THE ENTRY POINTS.                            *
+C*                                                                *
+C******************************************************************
+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
+      DIMENSION       SCRARR(1)
+C
+        SAVE
+C
+C  IFR - FLAG TO REGISTER FIRST PASS IN Y DIRECTION
+C
+C  LOAD THE SCRATCH SPACE AND CONVEX HULL POINTERS
+C  ITLOC IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO THE SCARTCH
+C  SPACE.
+C  PV IS THE LIST OF CONVEX HULL POINTERS RELATIVE TO USER COORDINATES
+C
+C  INITALIZE THE SPECIAL VALUE FEATURE
+C
+      X = (XED-XST)/2. + XST
+      Y = (YED-YST)/2. + YST
+      IF(LINEAR) GO TO 1
+      SPVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+        GO TO 2
+ 1    SPVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+ 2    CONTINUE
+C
+C  INITIALIZE THE SEARCH
+C
+      IYMAX = 0
+      IFR = 1
+      JX = 1
+      X = XST
+   10 JY = 1
+      Y = YST
+C
+C  SET HULL POINTERS FOR THIS COLUMN TO NULL
+C
+      ITLOC(JX*2-1) = 0
+      ITLOC(JX*2) = 0
+C
+C  FLAG START OF COLUMN
+C
+      LOOP = 1
+C
+C  GET INTERPOLATED VALUE
+C
+  20  IF (LINEAR) GO TO 3
+      RVAL = CONCOM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+      GO TO 4
+  3   RVAL = CONLCM(X,Y,XD,YD,ZD,NDP,WK,IWK,IT)
+  4   CONTINUE
+      SCRARR(JY+(JX-1)*IYMAX) = RVAL
+      IF (RVAL.GT.SPVAL) SPVAL = RVAL
+C
+C  IF OUTSIDE CONVEX HULL BRANCH
+C
+      IF (IT.GT.NTNL) GO TO    30
+C
+C  IF OUTSIDE TRIANGLES AND USING LINEAR INTERPLOATION THEN BRANCH
+C
+      IF(LINEAR.AND.IT.GT.NT) GO TO 30
+C
+C  IF FIRST OF COLUMN IN HULL CONTINUE THROUGH
+C
+      IF (LOOP.NE.1) GO TO    40
+C
+C  SET HULL POINTERS
+C
+      PV(JX*2-1) = Y
+      ITLOC(JX*2-1) = JY
+C
+C  SET FLAG TO LOOK FOR END OF HULL IN COLUMN
+C
+      LOOP = 2
+C
+C  GO FOR NEXT ENTRY
+C
+      GO TO    40
+C
+C  TEST FOR END OF CONVEX HULL ON THIS ROW
+C
+   30 IF (LOOP.NE.2) GO TO    40
+C
+C  END OF HULL SET POINTERS FOR END OF HULL AND FLAG IT VIA LOOP
+C
+      LOOP = 0
+      ITLOC(JX*2) = JY-1
+      PV(JX*2) = Y-STPSZ
+C
+C  GET NEXT ELEMENT IN ROW IF NOT OUTSIDE ENCLOSING RECTANGULAR
+C  BOARDER
+C
+   40 Y = Y+STPSZ
+      JY = JY+1
+      IF (Y.LE.YED) GO TO    20
+C
+C  TEST FOR FIRST COLUMN
+C
+      IF (IFR.NE.1) GO TO    50
+C
+C  FIRST COLUMN OVER SET MAX Y VALUES
+C
+      IYMAX = JY-1
+      YMAX = Y-STPSZ
+      IFR = 0
+C
+C  IF HULL WENT TO EDGE OF RECTANGULAR BOARDER SET HULL POINTERS HERE
+C
+   50 IF (LOOP.NE.2) GO TO    60
+      PV(JX*2) = Y-STPSZ
+      ITLOC(JX*2) = JY-1
+C
+C  END OF COLUMN GET NEXT ONE
+C
+   60 X = X+STPSZ
+      JX = JX+1
+C
+C  IF NOT END OF WORK CONTINUE WITH NEXT COLUMN
+C
+      IF (X.LE.XED) GO TO    10
+C
+C  END OF WORK SET MAX X VALUES
+C
+      IXMAX = JX-1
+      XMAX = X-STPSZ
+      RETURN
+      END