Initial commit

1 files changed, 178 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/conlib/conecd.f b/sys/gio/ncarutil/conlib/conecd.f
new file mode 100644
index 00000000..56d8a934
--- /dev/null
+++ b/sys/gio/ncarutil/conlib/conecd.f
@@ -0,0 +1,178 @@
+      SUBROUTINE CONECD (VAL,IOUT,NUSED)
+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  ENCODE A NUMBER IN THE LEAST AMOUNT OF SPACE
+C  ON INPUT
+C       VAL THE NUMBER TO BE ENCODED
+C  ON OUTPUT
+C       IOUT CHARACTER STRING FILLED WITH THE ENCODED RESULT, MUST BE ABLE TO
+C            HOLD UP TO 9 CHARACTERS.
+C
+C     NUSED NUMBER OF CHARACTERS IN IOUT
+C
+C  VALUE INPUT WILL BE SCALED BY SCALE IN CONRA2
+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 /CONR15/ ISTRNG
+        CHARACTER*64 ISTRNG
+        COMMON /CONR16/ FORM
+        CHARACTER*10 FORM
+        COMMON /CONR17/ NDASH, IDASH, EDASH
+        CHARACTER*10 NDASH, IDASH, EDASH
+C
+C
+        CHARACTER*(*)   IOUT
+        CHARACTER*6     IFMT1
+C
+C +NOAO - Variables CHTMP and IT are not used.
+C
+C       CHARACTER*9     CHTMP
+C       CHARACTER*1     IT
+C
+C -NOAO
+C
+        SAVE
+C
+      V = VAL
+C
+C  IF VAL EQUALS ZERO EASY PROCESSING
+C
+      IF (V.NE.0.) GO TO    20
+        IOUT = '0.0'
+      NUSED = 3
+      RETURN
+C
+C  SCALE VALUE
+C
+   20 V = V*SCALE
+C
+C  GET SIZE OF NUMBER
+C
+      LOG = IFIX(ALOG10(ABS(V))+.1)
+      IF (IABS(LOG).GT.4) GO TO    60
+C
+C  COMPUTE FLOATING POINT FIELD
+C
+      NS = IABS(LOG)+3
+      ND = 1
+      IF (LOG.GT.0) GO TO    40
+C
+C  LOG = 0 TEST FOR FRACTIONAL PART ONLY
+C
+      IF (ALOG10( ABS(V) ).GE.0.) GO TO    30
+C
+C  NUMBER LT 1 BUT GREATER THAN ZERO IN ABSOLUTE VALUE
+C
+      NS = 4
+      ND = 1
+      GO TO    40
+C
+C  NUMBER LESS THAN 10 BUT GE 1
+C
+   30 ND = 1
+      NS = 4
+C
+C  BUILD THE FORMAT
+C
+   40 IF (V.LT.0) NS = NS+1
+        IFMT1 = '(F . )'
+C
+C  INSERT THE FLOATING POINT FORMAT SIZE
+C
+C +NOAO - Scheme for creating format has been modified because it uses
+C         FTN internal writes.  NOAO mods are written in lower case.
+C
+C       WRITE(IT,'(I1)')NS
+C       IFMT1(3:3) = IT
+C       WRITE(IT,'(I1)')ND
+C       IFMT1(5:5) = IT
+C
+	ifmt1(1:6) = '(f . )'
+	ifmt1(3:3) = char (ns + ichar ('0') + 1)
+	ifmt1(5:5) = char (nd + ichar ('0'))
+C
+C  ENCODE THE DESIRED NUMBER
+C
+C       WRITE(CHTMP,IFMT1)V
+C       IOUT = CHTMP
+C
+        call encode (ns, ifmt1, iout, v)
+
+      NUSED = NS
+      RETURN
+C
+C  DATA LARGER THAN A NICE SIZE FORCE IT TO BE ENCODED
+C
+C 60  WRITE(CHTMP,'(E8.3)')V
+C     IOUT = CHTMP
+C
+  60  call encode (8, '(E8.3)', iout, v)
+C
+C -NOAO
+      NUSED = 8
+      RETURN
+C
+C******************************************************************
+C*                                                                *
+C*                   REVISION HISTORY                             *
+C*                                                                *
+C*  JUNE 1980   ADDED CONCOM TO ULIB                              *
+C*  AUGUST 1980 FIXED BOARDER CONTOUR DETECTION                   *
+C*  DECEMBER 1980 FIXED ERROR TRAP, CONTOUR REORDERING ALGORITHM  *
+C*                AND ERROR MESSAGE 10                            *
+C*  AUGUST 1983 ADDED LINEAR INTERPOLATION AND SHIELDING          *
+C*  JULY 1984 CONVERTED TO FORTRAN77 AND GKS                      *
+C*  AUGUST 1985 DELETED (MACHINE DEPENDENT) FUNCTION LOC; CHANGED *
+C*              COMMON /CONR13/                                   *
+C*                                                                *
+C******************************************************************
+C
+      END