From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- sys/gio/nspp/sysint/encd.f | 78 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 sys/gio/nspp/sysint/encd.f (limited to 'sys/gio/nspp/sysint/encd.f') 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 -- cgit