Initial commit

1 files changed, 78 insertions, 0 deletions

diff --git a/sys/gio/nspp/sysint/encd.f b/sys/gio/nspp/sysint/encd.f
new file mode 100644
index 00000000..1dba902b
--- /dev/null
+++ b/sys/gio/nspp/sysint/encd.f
@@ -0,0 +1,78 @@
+      SUBROUTINE ENCD (VALU,ASH,IOUT,NC,IOFFD)
+C
+C
+C
+C
+C ON INPUT     VALU	 FLOATING POINT	NUMBER FROM WHICH THE LABEL IS
+C			 TO BE CREATED.
+C	       ASH	 SEE IOFFD.
+C	       IOFFD	 IF IOFFD .EQ. 0, A LABEL WHICH	REFLECTS THE
+C			      MAGNITUDE	OF VALU	IS TO BE CREATED.
+C			      .1 .LE. ABS(VALU)	.LE. 99999.49999...
+C			      OR VALUE .EQ. 0.0.  THE LABEL CREATED
+C			      SHOULD HAVE 3 TO 5 CHARACTERS DEPENDING
+C			      ON THE MAGNITUDE OF VALU.	 SEE IOUT.
+C			 IF IOFFD .NE. 0, A LABEL WHICH	DOES NOT REFLECT
+C			      THE MAGNITUDE OF VALU IS TO BE CREATED.
+C			      ASH IS USED AS THE NORMALIZATION FACTOR.
+C			      1. .LE. ASH*ABS(VALU) .LT. 1000. OR
+C			      VALU .EQ.	0.0.  THE LABEL	CREATED	SHOULD
+C			      HAVE 1 TO	3 CHARACTERS, DEPENDING	ON THE
+C			      MAGNITUDE	OF ASH*VALU.  SEE IOUT.
+C ON OUTPUT    IOUT	 CONTAINS THE LABEL CREATED.  IT SHOULD	HAVE NO
+C			 LEADING BLANKS.  SEE NC.
+C	       NC	 THE NUMBERS IN	THE LABEL IN IOUT.  SHOULD BE
+C			 1 TO 5.
+C
+      SAVE
+      CHARACTER*11 IFMT, IOUT
+C
+C IFMT MUST HOLD 11 CHARACTERS
+C
+      VAL = VALU
+      IF (IOFFD	.NE. 0)	GO TO 103
+      IF (VAL) 101,104,101
+  101 LOG = IFIX((ALOG10(ABS(VAL))+.00001)+5000.)-5000
+      V	= VAL
+      NS = MAX0(4,MIN0(6,LOG+2))
+      ND = MIN0(3,MAX0(0,2-LOG))
+c     IF (VAL.LT.0)  NS	= NS + 1
+c +noao: replacing ftn i/o for iraf implementation
+c 102 WRITE (IFMT,'(A2,I2,A1,I1,A1)') '(F',NS,'.',ND,')'
+  102 continue
+c     if (len (char (ns + ichar ('0'))) .eq. 2) then
+c	 ifmt(1:7) = '(f  . )'
+c	 ifmt(3:4) = char (ns + ichar ('0'))
+c	 ifmt(6:6) = char (nd + ichar ('0'))
+c     else 
+c	 ifmt(1:6) = '(f . )'
+c	 ifmt(3:3) = char (ns + ichar ('0'))
+c	 ifmt(5:5) = char (nd + ichar ('0'))
+c     endif
+c     WRITE (IOUT,IFMT)	V
+      call encode (ns, ifmt, iout, v)
+      NC = NS
+c +noao
+c The following statement was making 5 digit labels (+4800) come out
+c truncated (+480) and it has been commented out.
+c     IF (LOG.GE.3)  NC	= NC - 1
+c -noao
+      RETURN
+  103 NS = 4
+      IF (VAL.LT.0.)  NS=5
+      IF (VAL.EQ.0.)  NS=2
+      ND = 0
+      V	= VAL*ASH
+      LOG = 100
+      GO TO 102
+  104 iout(1:3) = '0.0'
+      nc = 3
+c 104 NS = 3
+c     ND = 1
+c     LOG = -100
+c     V	= 0.
+c     GO TO 102
+C
+C1001 FORMAT('(F',I2,'.',I1,',1H',A1,')')
+C
+      END