Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/stp/stp13.for
There is 1 other file named stp13.for in the archive. Click here to see a list.
C                                     *** STAT PACK ***
C     SUBROUTINE USED TO PROVIDE USER WITH EASY METHOD OF TRANSFORMING
C     DATA AND SORTING.
C     CALLING SEQUENCE: CALL TRANS(NV,NC,MV,MC,DATA,VMN,STD,COR,NAMES,
C     SP,IVIP)
C     WHERE NV - NUMBER OF VARIABLES ACTUALLY USED
C           NC - NUMBER OF OBSERVATIONS ACTUALLY USED
C           MV - MAXIMUM NUMBER OF VARIABLES POSSIBLE
C           MC - MAXIMUM NUMBER OF OBSERVATIONS POSSIBLE
C           DATA - MATRIX CONTAINING DATA
C           VMN - VECTOR CONTAINING VARIABLE MEANS
C           STD - VECTOR CONTAINING VARIABLE STANDARD DEVIATIONS
C           COR - CORRELATION MATRIX
C           NAMES - VECTOR CONTAINING VARIABLE NAMES
C           SP - EXTRA VECTOR AT LEAST MC LONG
C           IVIP - EXTRA VECTOR AT LEAST NV LONG
C
C     ROUTINE ORIGINALLY REQUESTED BY ULDIS SCHMIDIENS (TEACHER ED)
C     BRAD HEITIMA (PSYCHOLOGY), AND MIKE KEENAN (MANAGEMENT).
C     SORT WAS IN PARTICULAR REQUESTED BY MORTY WAGENFIELD (SOC.)
C     CALLS ALSO THE ROUTINES: CALC,VARB,COMPD,AND SORT.
C     NOTE: NO FIXED POINT VARIABLES CREATED.
C
      SUBROUTINE TRANS (NV,NC,MV,MC,DATA,VMN,STD,COR,NAMES,SP,IVIP)
      DIMENSION DATA(MC,MV), COR(MV,MV), VMN(1), STD(1), NAMES(1)
      DIMENSION INST(25),IVAR1(25),IVAR2(25),CONST(25),SV(99),ITO(25),SP
     1(1)
      DIMENSION LINE(80),IVIP(1)
      COMMON/DEV/ICC,IDATA,IOUT,IDLG,IDSK
      COMMON /PRNT/ LINPP,ICOPS,RUNPRG
      COMMON/TRNF/ITYPES(9)
      EQUIVALENCE (WORD,IWORD)
      ITYPES(1)='('
      ITYPES(2)=')'
      ITYPES(3)=','
      ITYPES(4)='='
      ITYPES(5)='+'
      ITYPES(6)='-'
      ITYPES(7)='/'
      ITYPES(8)='*'
      ITYPES(9)=' '
1     IF(ICC.NE.2) WRITE (IDLG,2)
2     FORMAT (' ?',$)
      READ (ICC,3,END=9999) LINE
3     FORMAT (80A1)
      DO 5 I=80,1,-1
      IF (LINE(I).NE.' ') GO TO 6
5     CONTINUE
      GO TO 9999
6     IF ((LINE(1).EQ.'S').AND.(LINE(2).EQ.'T').AND.(LINE(3).EQ.'O')
     1.AND.(LINE(4).EQ.'P')) GO TO 9999
      N=I
      I=0
7     I=I+1
8     IF (I.GT.N) GO TO 9001
      IF (LINE(I).NE.' ') GO TO 7
      DO 9 J=I+1,N
9     LINE(J-1)=LINE(J)
      LINE(N)=' '
      N=N-1
      GO TO 8
9001  IF (LINE(1).EQ.'!') RETURN
      L=1
      N=1
      K=1
4     IPAR=0
      CALL COMPD (LINE,N,WORD,IDEF)
      IF ((IDEF.EQ.9).AND.(WORD.EQ.'HELP')) GO TO 300
      IF (IDEF.NE.1) GO TO 16
      IPAR=1
      IF (WORD.NE.'SORT') GO TO 10
      WRITE(IDLG,24)
24    FORMAT(' PLEASE USE SORT COMMAND')
      GO TO 1
10    IF (WORD.NE.'IFL') GO TO 11
      INST(K)=22
      GO TO 25
11    IF (WORD.NE.'IFE') GO TO 12
      INST(K)=21
      GO TO 25
12    IF (WORD.NE.'IFN') GO TO 13
      INST(K)=26
      GO TO 25
13    IF (WORD.NE.'IFG') GO TO 46
      INST(K)=24
      GO TO 25
46    IF(WORD.NE.'IF') GO TO 14
      INST(K)=20
      GO TO 25
14    WRITE(IDLG,15)
15    FORMAT ('+SORT MISSPELLED OR CONDITIONAL NOT CORRECT')
      GO TO 1
16    IF (IDEF.NE.4) GO TO 22
      INST(K)=4
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IV.LT.0) GO TO 22
      IF (IERR.NE.0) GO TO 17
      ITO(K)=IV
      GO TO 25
17    IF ((IERR.NE.1).AND.(IERR.NE.3)) GO TO 22
      IF ((NV+1).LE.MV) GO TO 19
      WRITE (IDLG,18)
18    FORMAT ('+NO MORE ROOM FOR NEW VARIABLES IN DATA SET SPECIFIED')
      GO TO 1
19    ITO(K)=NV+1
      IF (IERR.EQ.3) GO TO 20
      NAMES(NV+1)=IWORD
      GO TO 25
20    ENCODE (5,21,NAMES(NV+1)) ITO(K)
21    FORMAT (I3,2X)
      GO TO 25
22    WRITE (IDLG,23)
23    FORMAT ('+INSTRUCTION MUST HAVE FORM OF FORTRAN STATEMENT')
      GO TO 1
C
C     INSTRUCTION TYPE KNOWN, FIND INFORMATION NECESSARY
C
25    K=K+1
      IF (K.LE.25) GO TO 50
26    WRITE (IDLG,27)
27    FORMAT ('+INSTRUCTION TOO LONG')
      GO TO 1
37    IF(IERR.EQ.1) WRITE(IDLG,38)
      IF(IERR.EQ.2) WRITE(IDLG,39)
      IF(IERR.EQ.3) WRITE(IDLG,40)
38    FORMAT('+ONE OF THE VARIABLSE NAMES USED DOES NOT EXIST')
39    FORMAT('+# MUST BE FOLLOWED BY A VARIABLE')
40    FORMAT('+ONE OF THE VARIABLE NUMBERS USED DOES NOT EXIST')
      GO TO 1
C
C     CHECK FOR CONDITIONAL
C
50    IF ((INST(K-1).LT.20).OR.(INST(K-1).GT.26)) GO TO 80
      M=N
51    M=M+1
      IF (M.LT.80) GO TO 54
52    WRITE (IDLG,53)
53    FORMAT ('+UNBALANCED PARENTHESES')
      GO TO 1
54    IF (LINE(M).NE.'(') GO TO 55
      IPAR=IPAR+1
      GO TO 51
55    IF (LINE(M).NE.')') GO TO 51
      IPAR=IPAR-1
      IF (IPAR.GT.0) GO TO 51
      M=M-1
      IF(INST(K-1).NE.20) GO TO 90
      DO 91 II=N,M
      IF(LINE(II).NE.'.') GO TO 91
      IF((LINE(II+1).NE.'E').AND.(LINE(II+1).NE.'L').AND.
     1(LINE(II+1).NE.'G').AND.(LINE(II+1).NE.'N')) GO TO 91
      IF((LINE(II+2).NE.'Q').AND.(LINE(II+2).NE.'T').AND.
     1(LINE(II+2).NE.'E')) GO TO 91
      IF(LINE(II+3).NE.'.') GO TO 91
      WORD=' '
      ENCODE(4,3,WORD)(LINE(LLL),LLL=II,II+3)
      LLL=0
      IF(WORD.EQ.'.EQ.') LLL=21
      IF(WORD.EQ.'.LT.') LLL=22
      IF(WORD.EQ.'.LE.') LLL=23
      IF(WORD.EQ.'.GT.') LLL=24
      IF(WORD.EQ.'.GE.') LLL=25
      IF(WORD.EQ.'.NE.') LLL=26
      IF(LLL.EQ.0) GO TO 91
      INST(K-1)=LLL
      GO TO 93
91    CONTINUE
94    WRITE(IDLG,92)
92    FORMAT(' INCORRECT FORM OF IF STATEMENT')
      GO TO 1
93    LINE(II)='-'
      LINE(II+1)='('
      IF((II+3).EQ.M) GO TO 94
      DO 95 LLL=II+4,M
95    LINE(LLL-2)=LINE(LLL)
      LINE(M-1)=')'
      DO 96 LLL=M+1,80
96    LINE(LLL-1)=LINE(LLL)
      LINE(80)=' '
      M=M-1
90    CALL CALC (LINE,N,M,K,L,INST,IVAR1,IVAR2,ITO,CONST,SV,NV,NAMES,IER
     1RC)
      IF (IERRC.EQ.0) GO TO 70
56    IF (IERRC.EQ.1) WRITE (IDLG,53)
      IF (IERRC.EQ.2) WRITE (IDLG,60)
60    FORMAT ('+PARENTHESES DO NOT ENCLOSE ANYTHING')
      IF (IERRC.EQ.3) WRITE (IDLG,61)
61    FORMAT ('+POWER IS NOT A CONSTANT OR A VARIABLE')
      IF (IERRC.EQ.4) WRITE (IDLG,38)
      IF (IERRC.EQ.5) WRITE (IDLG,39)
      IF (IERRC.EQ.6) WRITE (IDLG,40)
      IF (IERRC.EQ.7) WRITE (IDLG,62)
62    FORMAT ('+TWO INSTRUCTIONS NOT SEPARATED BY A VARIABLE')
      IF (IERRC.EQ.8) WRITE (IDLG,63)
63    FORMAT ('+ATTEMPT TO DIVIDE BY A CONSTANT VALUE OF ZERO')
      IF (IERRC.EQ.9) WRITE (IDLG,27)
      IF (IERRC.EQ.10) WRITE (IDLG,64),IERRC
64    FORMAT ('0SYSTEM PROBLEM-CONTACT DICK HOUCHARD',I4)
      IF (IERRC.EQ.11) WRITE (IDLG,64),IERRC
      IF (IERRC.EQ.12) WRITE (IDLG,64),IERRC
      IF (IERRC.EQ.13) WRITE (IDLG,65)
65    FORMAT ('+TWO EXPRESSIONS NOT SEPARATED BY AN OPERATION')
      IF (IERRC.EQ.14) WRITE (IDLG,66)
66    FORMAT ('+"," IS NOT A LEGAL OPERATION')
      IF (IERRC.EQ.15) WRITE (IDLG,67)
67    FORMAT ('+"=" IS NOT A LEGAL OPERATION IN AN IF OR TWICE IN
     1AN EQUATION')
      IF (IERRC.EQ.16) WRITE (IDLG,64),IERRC
      IF (IERRC.EQ.17) WRITE (IDLG,65)
      IF (IERRC.EQ.18) WRITE (IDLG,68)
68    FORMAT ('+ILLEGAL OR MISSPELLED FUNCTION')
      IF (IERRC.EQ.19) WRITE (IDLG,69)
69    FORMAT ('+ATTEMPT TO TAKE MEAN OR STANDARD DEVIATION OF CONSTANT')
      GO TO 1
70    INST(K)=27
      CALL COMPD (LINE,N,WORD,IDEF)
      IF (IDEF.LE.9) GO TO 72
      WRITE (IDLG,71)
71    FORMAT ('+IF ON A CONSTANT IS ILLEGAL')
      GO TO 1
72    CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 17
      ITO(K)=IV
      K=K+1
      IF(K.GT.25) GO TO 26
      GO TO 4
C
C     END OF CONDITIONAL
C
C
C     CHECK FOR EQUALITY
C
80    M=N
81    M=M+1
      IF (M.GT.80) GO TO 82
      IF (LINE(M).NE.' ') GO TO 81
82    M=M-1
      CALL CALC (LINE,N,M,K,L,INST,IVAR1,IVAR2,ITO,CONST,SV,NV,NAMES,IER
     1RC)
      IF (IERRC.NE.0) GO TO 56
      CALL COMPD (LINE,N,WORD,IDEF)
      IF ((IDEF.NE.9).AND.(IDEF.NE.19)) PAUSE 'BOAB'
      INST(K)=9
      IF (IDEF.EQ.19) GO TO 83
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 37
      ITO(K)=IV
      GO TO 100
83    ITO(K)=0
      CONST(K)=WORD
      GO TO 100
C
C     ------------------------------------------------------------------
C
C     CODING DONE NOW BEGIN WORK
C
C     ------------------------------------------------------------------
C
100   ISDBZ=0
      ISSQTN=0
      KCODFN=0
      DO 1100 I=1,K
      IF(INST(I).NE.4) GO TO 1100
      KCODFN=ITO(I)
      GO TO 1101
1100  CONTINUE
1101  KNV=NV
      IF(KCODFN.GT.KNV) KNV=KCODFN
      DO 1102 I=1,KNV
1102  SP(I)=0
      XM=0
      DO 900 I=1,NC
      N=1
103   KCODE=INST(N)
      KCODTO=ITO(N)
106   N=N+1
      IF (N.GT.K) PAUSE 'CODING PROB'
      INSOP=INST(N)
      INPUT=ITO(N)
      IF (INSOP.EQ.99) GO TO 106
      IF (INSOP.NE.9) GO TO 107
      IF (INPUT.EQ.0) DATA(I,KCODTO)=CONST(N)
      IF(INPUT.LT.0) DATA(I,KCODTO)=SV(-INPUT)
      IF(INPUT.GT.0) DATA(I,KCODTO)=DATA(I,INPUT)
      GO TO 800
107   GO TO (108,108,130,108,110,120,140,150,108,160,170,180,190,200,210
     1,220,230,240,250,270,108,108,108,108,108,108,260,280,290) INSOP
108   WRITE (IDLG,109)
109   FORMAT (' SYSTEM PROB-CONTACT DICK HOUCHARD')
      GO TO 1
C
C     ADD
C
110   IF (IVAR1(N)) 111,112,113
111   WORD1=SV(-IVAR1(N))
      GO TO 114
112   WORD1=CONST(N)
      GO TO 114
113   WORD1=DATA(I,IVAR1(N))
114   IF (IVAR2(N)) 115,116,117
115   WORD2=SV(-IVAR2(N))
      GO TO 118
116   WORD2=CONST(N)
      GO TO 118
117   WORD2=DATA(I,IVAR2(N))
118   SV(INPUT)=WORD1+WORD2
      GO TO 106
C
C     SUBTRACT
C
120   IF (IVAR1(N)) 121,122,123
121   WORD1=SV(-IVAR1(N))
      GO TO 124
122   WORD1=CONST(N)
      GO TO 124
123   WORD1=DATA(I,IVAR1(N))
124   IF (IVAR2(N)) 125,126,127
125   WORD2=SV(-IVAR2(N))
      GO TO 128
126   WORD2=CONST(N)
      GO TO 128
127   WORD2=DATA(I,IVAR2(N))
128   SV(INPUT)=WORD1-WORD2
      GO TO 106
C
C     POWER
C
130   IF (IVAR1(N)) 131,132,133
131   WORD1=SV(-IVAR1(N))
      GO TO 134
132   WORD1=CONST(N)
      GO TO 134
133   WORD1=DATA(I,IVAR1(N))
134   IF (IVAR2(N)) 135,136,137
135   WORD2=SV(-IVAR2(N))
      GO TO 138
136   WORD2=CONST(N)
      GO TO 138
137   WORD2=DATA(I,IVAR2(N))
138   SV(INPUT)=WORD1**WORD2
      GO TO 106
C
C     DIVIDE
C
140   IF (IVAR1(N)) 141,142,143
141   WORD1=SV(-IVAR1(N))
      GO TO 144
142   WORD1=CONST(N)
      GO TO 144
143   WORD1=DATA(I,IVAR1(N))
144   IF (IVAR2(N)) 145,146,147
145   WORD2=SV(-IVAR2(N))
      GO TO 148
146   WORD2=CONST(N)
      GO TO 148
147   WORD2=DATA(I,IVAR2(N))
148   IF (WORD2.NE.0) GO TO 149
      ISDBZ=1
      SV(INPUT)=-9999E-20
      GO TO 106
149   SV(INPUT)=WORD1/WORD2
      GO TO 106
C
C     MULTIPLY
C
150   IF (IVAR1(N)) 151,152,153
151   WORD1=SV(-IVAR1(N))
      GO TO 154
152   WORD1=CONST(N)
      GO TO 154
153   WORD1=DATA(I,IVAR1(N))
154   IF (IVAR2(N)) 155,156,157
155   WORD2=SV(-IVAR2(N))
      GO TO 158
156   WORD2=CONST(N)
      GO TO 158
157   WORD2=DATA(I,IVAR2(N))
158   SV(INPUT)=WORD1*WORD2
      GO TO 106
C
C     SQRT
C
160   IF (IVAR1(N)) 161,162,163
161   WORD1=SV(-IVAR1(N))
      GO TO 164
162   WORD1=CONST(N)
      GO TO 164
163   WORD1=DATA(I,IVAR1(N))
164   IF (WORD1.GE.0) GO TO 165
      ISSQTN=1
      WORD1=-WORD1
165   SV(INPUT)=SQRT(WORD1)
      GO TO 106
C
C     LN
C
170   IF (IVAR1(N)) 171,172,173
171   WORD1=SV(-IVAR1(N))
      GO TO 174
172   WORD1=CONST(N)
      GO TO 174
173   WORD1=DATA(I,IVAR1(N))
174   SV(INPUT)=ALOG(WORD1)
      GO TO 106
C
C     EXP
C
180   IF (IVAR1(N)) 181,182,183
181   WORD1=SV(-IVAR1(N))
      GO TO 184
182   WORD1=CONST(N)
      GO TO 184
183   WORD1=DATA(I,IVAR1(N))
184   SV(INPUT)=EXP(WORD1)
      GO TO 106
C
C     LOG10
C
190   IF (IVAR1(N)) 191,192,193
191   WORD1=SV(-IVAR1(N))
      GO TO 194
192   WORD1=CONST(N)
      GO TO 194
193   WORD1=DATA(I,IVAR1(N))
194   SV(INPUT)=ALOG10(WORD1)
      GO TO 106
C
C     SIN
C
200   IF (IVAR1(N)) 201,202,203
201   WORD1=SV(-IVAR1(N))
      GO TO 204
202   WORD1=CONST(N)
      GO TO 204
203   WORD1=DATA(I,IVAR1(N))
204   SV(INPUT)=SIN(WORD1)
      GO TO 106
C
C     COS
C
210   IF (IVAR1(N)) 211,212,213
211   WORD1=SV(-IVAR1(N))
      GO TO 214
212   WORD1=CONST(N)
      GO TO 214
213   WORD1=DATA(I,IVAR1(N))
214   SV(INPUT)=COS(WORD1)
      GO TO 106
C
C     MEAN
C
220   SV(INPUT)=VMN(IVAR1(N))
      GO TO 106
C
C     STD DEV
C
230   SV(INPUT)=STD(IVAR1(N))
      GO TO 106
C
C     ARC TANGENT
C
240   IF (IVAR1(N)) 241,242,243
241   WORD1=SV(-IVAR1(N))
      GO TO 244
242   WORD1=CONST(N)
      GO TO 244
243   WORD1=DATA(I,IVAR1(N))
244   SV(INPUT)=ATAN(WORD1)
      GO TO 106
C
C     ARC SIN
C
250   IF (IVAR1(N)) 251,252,253
251   WORD1=SV(-IVAR1(N))
      GO TO 254
252   WORD1=CONST(N)
      GO TO 254
253   WORD1=DATA(I,IVAR1(N))
254   SV(INPUT)=ASIN(WORD1)
      GO TO 106
C
C     ABSOLUTE VALUE
C
270   IF(IVAR1(N)) 271,272,273
271   WORD1=SV(-IVAR1(N))
      GO TO 274
272   WORD1=CONST(N)
      GO TO 274
273   WORD1=DATA(I,IVAR1(N))
274   SV(INPUT)=WORD1
      IF(WORD1.LT.0) SV(INPUT)=-WORD1
      GO TO 106
C
C     RANDOM NUMBER
C
280   SV(INPUT)=RAN(RANNUM)
      GO TO 106
C
C     NORMAL RANDOM NUMBER
C
290   WORD1=0
      DO 291 J=1,12
291   WORD1=WORD1+RAN(RANNUM)
      SV(INPUT)=WORD1-6.
      GO TO 106
C
C     END OF IF
C
260   IF (INPUT) 261,261,262
261   WORD1=SV(-INPUT)
      GO TO 263
262   WORD1=DATA(I,INPUT)
263   N=N+1
      IF ((KCODE.EQ.21).AND.(WORD1.EQ.0)) GO TO 103
      IF ((KCODE.EQ.22).AND.(WORD1.LT.0)) GO TO 103
      IF ((KCODE.EQ.23).AND.(WORD1.LE.0)) GO TO 103
      IF ((KCODE.EQ.24).AND.(WORD1.GT.0)) GO TO 103
      IF((KCODE.EQ.25).AND.(WORD1.GE.0)) GO TO 103
      IF((KCODE.EQ.26).AND.(WORD1.NE.0)) GO TO 103
      IF(KCODFN.EQ.0) GO TO 900
      IF(KCODFN.GT.NV) DATA(I,KCODFN)=-9999E-20
800   XM=XM+DATA(I,KCODFN)
      DO 801 J=1,KNV
801   SP(J)=DATA(I,J)*DATA(I,KCODFN)+SP(J)
900   CONTINUE
      IF(KCODFN.EQ.0) GO TO 1
      IFF=0
      IF (KCODFN.GT.NV) IFF=1
      IF (KCODFN.GT.NV) NV=KCODFN
      VMN(KCODFN)=XM/NC
      STD(KCODFN)=SQRT((SP(KCODFN)-NC*VMN(KCODFN)**2)/(NC-1))
      DO 904 J=1,NV
      IF (J.EQ.KCODFN) GO TO 903
      IF ((STD(J)*STD(KCODFN)).EQ.0) GO TO 902
      COR(J,KCODFN)=(SP(J)-NC*VMN(J)*VMN(KCODFN))/((NC-1)*STD(KCODFN)
     1*STD(J))
      GO TO 904
902   COR (J,KCODFN)=0
      GO TO 904
903   COR (J,KCODFN)=1.0
904   COR (KCODFN,J)=COR(J,KCODFN)
      IF (IFF.NE.1) WRITE (IDLG,905) NAMES (KCODFN)
905   FORMAT (' VARIABLE: ',A5,' HAS BEEN TRANSFORMED')
      IF (IFF.EQ.1) WRITE (IDLG,906) NAMES (KCODFN)
906   FORMAT (' VARIABLE: ',A5,' HAS BEEN CREATED')
      IF (ISDBZ.EQ.1) WRITE (IDLG,907)
907   FORMAT (' ALL OCCURENCES OF DIVISION BY ZERO REPLACED BY -9999E-20
     1')
      IF (ISSQTN.EQ.1) WRITE (IDLG,908)
908   FORMAT (' ALL OCCURENCES OF SQRT OF NEG. NUMBER--ABS VAL OF NUMBER
     1 USED')
      GO TO 1
300   WRITE(IDLG,301)
301   FORMAT('0TRANSFORMATIONS ARE WRITTEN IN THE SAME MANNER AS',
     1' FORTRAN'/' INSTRUCTIONS.  THE VARIABLE TO BE MODIFIED OR',
     2' CREATED IS'/' FOLLOWED BY AN "=" AND THEN BY THE EXPRESSION',
     3' IT IS TO BE'/' SET EQUAL TO (THE EXPRESSION TO THE RIGHT OF',
     4' THE "=" WILL BE'/' EVALUATED AND THE FINAL VALUE PLACED IN',
     5' THE VARIABLE TO'/' THE LEFT OF THE EQUALS).  HIERARCHY IS',
     6' THE SAME AS FOR'/' FORTRAN: POWERS FIRST, MULTIPLICATION',
     7' AND DIVISION NEXT,'/
     8' AND FINALLY ADDITION AND SUBTRACTION.  INSTRUCTIONS ARE'/
     9' EVALUATED FROM LEFT TO RIGHT.  PARENTHESES ARE EVALUATED'/
     1' PRIOR TO REMAINING PORTIONS OF THE INSTRUCTION, ALWAYS'/
     2' BEGINNING WITH THE INNERMOST PARENTHESES.  FUNCTIONS'/
     3' WHICH MAY BE USED ARE:'/
     4'   SQRT  - SQUARE ROOT'/
     5'   LN    - NATURAL LOG'/
     6'   EXP   - EXPONENTIAL (E TO THE X)'/
     7'   LOG10 - LOG BASE 10'/
     8'   SIN   - SIN'/
     9'   COS   - COSINE'/
     1'   ABS   - ABSOLUTE VALUE')
      WRITE(IDLG,302)
302   FORMAT('   MEAN  - MEAN OF VARIABLE'/
     1'   STD   - STANDARD DEVIATION OF VARIABLE'/
     2'   ARCTN - ARC TANGENT'/
     3'   ARCSN - ARC SIN'/
     4'0THE "TRANS" COMMAND CONTAINS FOUR CONDITIONAL CODES:'/
     5'    IFE - IF EQUAL TO ZERO'/
     6'    IFN - IF NOT EQUAL TO ZERO'/
     7'    IFL - IF LESS THAN ZERO'/
     8'    IFG - IF GREATER THAN ZERO'/
     9'0THE CONDITIONAL CODE IS FOLLOWED BY AN EXPRESSION ENCLOSED'/
     1' IN PARENTHESES FOR USE WITH THE CODE, AND FINALLY THE '/
     2' TRANSFORMATION TO BE ACCOMPLISHED IF THE CONDITION IS'/
     3' SATISFIED.  FOR EACH OBSERVATION THE EXPRESSION FOLLOWING'/
     4' THE CONDITIONAL CODE IS EVALUATED, IF THE FINAL VALUE'/
     5' SATISFIES THE CONDITIONAL CODE THE TRANSFORMATION IS DONE'/
     6' FOR THAT OBSERVATION.  IF THE CONDITIONAL CODE IS NOT'/
     7' SATISFIED, NO ACTION IS TAKEN ON THAT OBSERVATION AND THE'/
     8' ROUTINE PROCEEDS TO THE NEXT OBSERVATION.')
      WRITE(IDLG,303)
303   FORMAT('0VARIABLES MAY BE DEFINED BY NAMES OR IF VARIABLE'/
     7' NUMBERS ARE USED, A "#" FOLLOWED BY THE VARIABLE'/
     8' NUMBER.  INSTRUCTION SIZE IS LIMITED TO 1 LINE'/
     9' (72 CHARACTERS). TO END TRANSFROMATIONS TYPE A CARRIAGE RETURN'/
     1' OR ^Z.')
      WRITE(IDLG,304)
304   FORMAT('0EXAMPLES:'/
     3'0IQ=MENTL/PHYSL           CREATE OR MODIFY VARIABLE: IQ',
     4' SETTING IT'/26X,'EQUAL TO VARIABLE: MENTL DIVIDED BY',
     5' VARIABLE:'/26X,'PHYSL'/'0DIF=MEAS1-MEAS2',9X,
     6' CREATE OR MODIFY VARIABLE: DIF SETTING IT'/
     726X,'EQUAL TO VARIABLE: MEAS2 SUBTRACTED FROM'/
     826X,'VARIABLE: MEAS2'/'0Z=(WT-MEAN(WT))/STD(WT) ',
     9' CREATE OR MODIFY VARIABLE: Z BY SUBTRACTING'/
     125X,' THE MEAN OF VARIABLE: WT FROM VARIABLE: WT'/
     225X,' AND DIVIDING THAT BY THE STANDARD DEVIATION'/
     325X,' FOR VARIABLE WT.'/
     4'0IFG(#3-1)#3=LN(#3)'
     57X,'IF THE QUANTITY VARIABLE NUMBER 3 MINUS 1 IS'/
     626X,'GREATER THAN ZERO REPLACE VARIABLE NUMBER 3'/
     726X,'WITH THE NATURAL LOGARITHM OF VARIABLE NUMBER'/
     826X,'3'/'0CRIT=3.17+#4**(2+AGE*SQRT(7*#5))',
     94X,'EXAMPLE OF COMPLEX TRANSFORMATION')
      GO TO 1
9999  RETURN
      END
C                                 *** STAT PACK ***
C     SUBROUTINE PART OF TRANS USED FOR CODEING EXPRESSIONS
C     CALLING SEQUENCE: CALL CALC(LINE,N,M,K,L,INST,IVAR1,IVAR2,
C     ITO,CONST,SV,NV,NAMES,IERRC)
C     WHERE LINE - IS A VECTOR CONTAINING THE INSTRUCTION INPUT BY
C                  THE USER
C           N - IS A POINTER INDICATING THE FIST POSITION IN LINE
C               PREVIOUS TO THE EXPRESSION TO BE ANALYSED
C           M - IS A POINTER INDICATING THE FIRST POSITION IN THE LINE
C               AFTER THE EXPRESSION TO BE EVALUATED.
C           K - IS A POINTER INDICATING WHERE CODING FOR THE NEXT
C               INSTRUCTION IS TO BE PLACED IN INST.
C           L - IS A POINTER INDICATING WHERE THE ANSWER FOR THE 
C               NEXT CALCULATION IS TO BE PLACED IN SV.
C           INST - IS A VECTOR CONTAINING THE CALCULATIONS TO 
C                  BE PERFORMED IN ORDER OF CALCULATION
C           IVAR1 - IS A VECTOR CONTAINING ONE OF THE VARIABLES TO BE
C                   TO BE ACTED UPON BY THE CORRESPONDING INSTRUCTION
C                   IN INST.  IF IVAR1 IS NEGATIVE ITS ABSOLUTE REFERS
C                   TO SV, IF ZERO TO THE CORRESPONDING CONST, IF
C                   POSITIVE TO A VARIABLE WITH THAT NUMBER.
C           IVAR2 - IS A VECTOR CONTAINING ONE OF THE VARIABLES TO BE
C                   ACTED UPON BY THE CORRESPONDING INSTRUCTION IN
C                   INST.  IF IVAR2 IS NEGATIVE ITS ABSOLUTE REFERS TO
C                   SV, IF ZERO TO THE CORRESPONDING CONST, IF POSITIVE
C                   TO THE VARIABLE WITH THAT NUMBER.
C           ITO - IS A VECTOR CONTAINING THE ADDRESS OF SV WHERE EACH
C                 CORRESPONDING CALCULATION CALLED FOR IN INST ARE TO 
C                 BE PLACED.
C           CONST - IS A VECTOR CONTAINING THE CONSTANT VALUE
C                   (IF ONE WAS SPECIFIED) WHICH IS TO BE USED
C                   IN THE CALCULATION SPECIFIED IN THE CORRESPONDING
C                   INST.  IF EITHER IVAR1 OR IVAR2 IS ZERO IT REFERS
C                   TO THE CONST.
C           SV - IS A VECTOR WHERE SPECIAL VALUES ORE PLACED, OR RESULTS
C                OF CERTAIN CALCULATIONS HELD.  IT IS REFERED TO BY
C                ITO; AND IVAR1 OR IVAR2 IF THEY ARE NEGATIVE
C           NV - NUMBER OF VARIABLES ACTUALLY USED
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES
C           IERRC - IS A WORD TO BE USED FOR RETURNING ERROR CODES
C
C      HIERCHY IS THE SAME AS FORTRAN
C      ROUTINE ALSO CALLS COMPD AND VARB
C
      SUBROUTINE CALC (LINE,N,M,K,L,INST,IVAR1,IVAR2,ITO,CONST,SV,NV,NAM
     1ES,IERRC)
      DIMENSION LINE(1),INST(1),IVAR1(1),IVAR2(1),ITO(1),CONST(1),SV(1),
     1NAMES(1)
      DIMENSION IZ(2)
      COMMON/TRNF/ITYPES(9)
      EQUIVALENCE (IWORD,WORD)
1     IERRC=0
      MA=0
      MB=0
      NA=N-1
2     NA=NA+1
      IF (NA.GT.M) GO TO 4
      IF (LINE(NA).EQ.'(') MA=NA+1
      IF (LINE(NA).NE.')') GO TO 2
      MB=NA-1
      IF (MA.GT.0) GO TO 3
      IERRC=1
      RETURN
3     IF (MA.LE.MB) GO TO 4
      IERRC=2
      RETURN
4     KK=0
      IF (MA.EQ.0) MA=N
      IF (MB.EQ.0) MB=M
5     KK=KK+1
      NZ=MA
      GO TO (90,6,20,30,60) KK
90    NZ1=NZ
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF(IDEF.NE.-6) GO TO 5
      INST(K)=6
      IVAR1(K)=0
      CONST(K)=0
      CALL COMPD(LINE,NZ,WORD,IDEF)
      IF(IDEF.LT.10) GO TO 91
      SV(L)=-WORD
      CONST(K)=SV(L)
      INST(K)=99
      GO TO 50
91    CALL VARB(IWORD,IERR,IV,NAMES,NV)
      IF(IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
6     NZ1=NZ
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (NZ.GT.MB) GO TO 5
      IF ((IDEF.NE.8).AND.(IDEF.NE.18)) GO TO 6
      IF (LINE(NZ).NE.'*') GO TO 6
      NZ=NZ+1
      INST(K)=3
      IF (IDEF.EQ.18) GO TO 12
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.EQ.0) GO TO 8
10    IERRC=IERR+3
      RETURN
8     IVAR1(K)=IV
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.LE.0) GO TO 21
      IF (IDEF.GT.9) GO TO 11
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
11    IVAR2(K)=0
      CONST(K)=WORD
      GO TO 50
12    CONST(K)=WORD
      IVAR1(K)=0
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.LE.0) GO TO 21
      IF (IDEF.GT.9) GO TO 14
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
14    INST(K)=99
      SV(L)=CONST(K)**WORD
      INST(K)=99
      CONST(K)=SV(L)
      GO TO 50
C
C     DIVIDE MULTIPLY HIERACHY
C
20    NZ1=NZ
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (NZ.GT.MB) GO TO 5
      IF ((IDEF.NE.8).AND.(IDEF.NE.18).AND.(IDEF.NE.7).AND.(IDEF.NE.17))
     1GO TO 20
      IF ((IDEF.EQ.8).OR.(IDEF.EQ.18)) INST(K)=8
      IF ((IDEF.EQ.7).OR.(IDEF.EQ.17)) INST(K)=7
      IF (IDEF.GT.9) GO TO 24
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR1(K)=IV
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.GT.0) GO TO 22
21    IERRC=7
      RETURN
22    IF (IDEF.GT.9) GO TO 23
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
23    IVAR2(K)=0
      CONST(K)=WORD
      IF (WORD.NE.0) GO TO 50
      IERRC=8
      RETURN
24    CONST(K)=WORD
      IVAR1(K)=0
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.LE.0) GO TO 21
      IF (IDEF.GT.9) GO TO 25
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
25    IF (INST(K).EQ.8) SV(L)=CONST(K)*WORD
      IF ((INST(K).NE.7).OR.(WORD.NE.0)) GO TO 26
      IERRC=8
      RETURN
26    IF (INST(K).EQ.7) SV(L)=CONST(K)/WORD
      INST(K)=99
      CONST(K)=SV(L)
      GO TO 50
C
C     ADD SUBTRACT HIERACHY
C
30    NZ1=NZ
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (NZ.GT.MB) GO TO 5
      IF ((IDEF.NE.5).AND.(IDEF.NE.15).AND.(IDEF.NE.6).AND.(IDEF.NE.16))
     1 GO TO 30
      IF ((IDEF.EQ.5).OR.(IDEF.EQ.15)) INST(K)=5
      IF ((IDEF.EQ.6).OR.(IDEF.EQ.16)) INST(K)=6
      IF (IDEF.GT.9) GO TO 34
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR1(K)=IV
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.LE.0) GO TO 21
      IF (IDEF.GT.9) GO TO 33
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
33    IVAR2(K)=0
      CONST(K)=WORD
      GO TO 50
34    CONST(K)=WORD
      IVAR1(K)=0
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.LE.0) GO TO 21
      IF (IDEF.GT.9) GO TO 35
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR2(K)=IV
      GO TO 50
35    IF (INST(K).EQ.5) SV(L)=CONST(K)+WORD
      IF (INST(K).EQ.6) SV(L)=CONST(K)-WORD
      CONST(K)=SV(L)
      INST(K)=99
      GO TO 50
50    ITO(K)=L
      ENCODE (2,51,IWORD) L
51    FORMAT (I2)
      DECODE (2,52,WORD) IZ
52    FORMAT (2A1)
      NZ2=NZ1
      IDIF=0
      IF(L.GT.9) IDIF=1
      IDIF=NZ-NZ1-3-IDIF
      IF(IDIF.EQ.0) GO TO 85
      IF(IDIF.GT.0) GO TO 82
      DO 81 I=80+IDIF,NZ-1,-1
81    LINE(I-IDIF)=LINE(I)
      GO TO 85
82    DO 83 I=NZ-1,80
83    LINE(I-IDIF)=LINE(I)
      DO 84 I=81-IDIF,80
84    LINE(I)=' '
      GO TO 85
85    MB=MB-IDIF
      M=M-IDIF
      LINE (NZ1)="771004020100
      NZ1=NZ1+1
      IF (IZ(1).EQ.' ') GO TO 53
      LINE (NZ1)=IZ(1)
      NZ1=NZ1+1
53    LINE (NZ1)=IZ(2)
      NZ1=NZ1+1
57    L=L+1
      IF (L.GT.99) PAUSE 'PROBLEM'
      NZ=NZ2
      K=K+1
      IF (K.LE.25) GO TO 56
      IERRC=9
      RETURN
56    GO TO (5,6,20,30) KK
60    NZ=MA
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (NZ.GT.MB) GO TO 62
61    IERRC=10
      RETURN
62    IF ((MA.EQ.N).AND.(MB.EQ.M)) RETURN
      IF ((IDEF.EQ.2).OR.(IDEF.EQ.12)) GO TO 63
      IERRC=11
      RETURN
63    IF ((LINE(NZ).EQ.'+').OR.(LINE(NZ).EQ.'-').OR.(LINE(NZ).EQ.'*').OR
     1.(LINE(NZ).EQ.'/').OR.(LINE(NZ).EQ.' ').OR.(LINE(NZ).EQ.')'))
     2 GO TO 64
      IERRC=13
      RETURN
64    MA=MA-1
      IF (LINE(MA).EQ.'(') GO TO 65
      IERRC=12
      RETURN
65    MA=MA-1
      DO 70 I=1,9
      IF (LINE(MA).NE.ITYPES(I)) GO TO 70
      IF (I.NE.3) GO TO 66
      IERRC=14
      RETURN
66    IF (I.NE.4) GO TO 58
      IF(MA.LT.N) GO TO 58
      IERRC=15
      RETURN
58    IF(I.NE.2) GO TO 67
      IERRC=13
      RETURN
67    DO 68 J=MA+2,80
68    LINE (J-1)=LINE(J)
      LINE (80)=' '
      DO 69 J=NZ-1,80
69    LINE (J-1)=LINE(J)
      LINE (80)=' '
      M=M-2
      GO TO 1
70    CONTINUE
71    MA=MA-1
      IF (MA.GT.0) GO TO 72
      IERRC=16
      RETURN
72    DO 7 I=1,9
      IF (LINE(MA).NE.ITYPES(I)) GO TO 7
      IF ((I.GE.4).AND.(I.LE.8)) GO TO 73
      IF(I.EQ.1) GO TO 73
      IERRC=17
      RETURN
7     CONTINUE
      GO TO 71
73    NZ=MA+1
      CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.NE.1) PAUSE 'NONONO'
      INST(K)=0
      IF (WORD.EQ.'SQRT') INST(K)=10
      IF (WORD.EQ.'LN') INST(K)=11
      IF (WORD.EQ.'EXP') INST(K)=12
      IF (WORD.EQ.'LOG10') INST(K)=13
      IF (WORD.EQ.'SIN') INST(K)=14
      IF (WORD.EQ.'COS') INST(K)=15
      IF (WORD.EQ.'MEAN') INST(K)=16
      IF (WORD.EQ.'STD') INST(K)=17
      IF (WORD.EQ.'ARCTN') INST(K)=18
      IF (WORD.EQ.'ARCSN') INST(K)=19
      IF(WORD.EQ.'ABS') INST(K)=20
      IF(WORD.EQ.'RAN') INST(K)=28
      IF(WORD.EQ.'NORM') INST(K)=29
      IF (INST(K).NE.0) GO TO 74
      IERRC=18
      RETURN
74    CALL COMPD (LINE,NZ,WORD,IDEF)
      IF (IDEF.EQ.12) GO TO 75
      CALL VARB (IWORD,IERR,IV,NAMES,NV)
      IF (IERR.NE.0) GO TO 10
      IVAR1(K)=IV
      IF ((INST(K).NE.16).AND.(INST(K).NE.17)) GO TO 77
      IF (IVAR1(K).GT.0) GO TO 77
      IERRC=19
      RETURN
75    IF (INST(K).EQ.10) SV(L)=SQRT(WORD)
      IF (INST(K).EQ.11) SV(L)=ALOG(WORD)
      IF (INST(K).EQ.12) SV(L)=EXP(WORD)
      IF (INST(K).EQ.13) SV(L)=ALOG10(WORD)
      IF (INST(K).EQ.14) SV(L)=SIN(WORD)
      IF (INST(K).EQ.15) SV(L)=COS(WORD)
      IF ((INST(K).NE.16).AND.(INST(K).NE.17)) GO TO 76
      IERRC=19
      RETURN
76    IF (INST(K).EQ.18) SV(L)=ATAN(WORD)
      IF (INST(K).EQ.19) SV(L)=ASIN(WORD)
      IF((INST(K).EQ.20).AND.(WORD.GE.0)) SV(L)=WORD
      IF((INST(K).EQ.20).AND.(WORD.LT.0)) SV(L)=-WORD
      IF((INST(K).EQ.28).OR.(INST(K).EQ.29)) GO TO 77
      INST(K)=99
      CONST(K)=SV(L)
77    ITO(K)=L
      ENCODE (2,51,WORD) L
      DECODE (2,52,WORD) IZ
      NZ1=MA+1
      LINE (NZ1)="771004020100
      NZ1=NZ1+1
      IF (IZ(1).EQ.' ') GO TO 78
      LINE (NZ1)=IZ(1)
      NZ1=NZ1+1
78    LINE (NZ1)=IZ(2)
      NZ1=NZ1+1
      IDIF=NZ-NZ1
      DO 79 I=NZ,80
79    LINE (I-IDIF)=LINE(I)
      DO 80 I=81-IDIF,80
80    LINE (I)=' '
      M=M-IDIF
      L=L+1
      IF (L.GT.99) PAUSE 'PROB1'
      K=K+1
      IF (K.LE.25) GO TO 1
      IERRC=9
      RETURN
      END
C                               *** STAT PACK ***
C     SUBROUTINE PART OF TRANS USED TO RETURN VARIABLE
C     CALLING SEQUENCE: CALL VARB(IWORD,IERR,IV,NAMES,NV)
C     WHERE IWORD - IS THE VARIBLE NAME SENT 
C           IERR - IS ZERO IF THE NAME EXISTS,OR IF ITS A LEGAL
C                  VARIABLE NUMBER (PRECEDED BY #), OR IF ITS A
C                  SPECIAL VALUE (PRECEDED BY OCTAL 771004020100)
C                  (IN WHICH CASE IV IS NEGATIVE WHEN RETURNED).
C                  IF WORD IS NOT LEGAL: NOT PRECEDED BY # OR OCTAL
C                  771004020100 THEN ERROR IS SET TO 1. IF A # IS NOT
C                  FOLLOWED BY A NUMBER, IERR IS SET TO 2
C                  AND IF WORD IS A VARIABLE NUMBER OUTSIDE THE LEGAL
C                  RANGE ERR=3.
C           IV - VARIABLE NUMBER IS RETURNED HERE. A NEGATIVE NUMBER
C                INDICATES THE VARIABLE IS SPECIAL (SV)
C           NAMES - IS A VECTOR CONTAINING VARIABLE NAMES.
C           NV - NUMBER OF VARIABLES ACTUALLY USED.
C
      SUBROUTINE VARB (IWORD,IERR,IV,NAMES,NV)
      DIMENSION NAMES(1),TAKPT(5)
      IERR=0
      IV=0
      DO 1 I=1,NV
      IF (IWORD.NE.NAMES(I)) GO TO 1
      IV=I
      GO TO 13
1     CONTINUE
      DO 100 I=1,5
100   TAKPT(I)=' '
      DECODE (5,2,IWORD) TAKPT
2     FORMAT (5A1)
      IF (TAKPT(1).NE.'#') GO TO 8
      TAKPT(1)=' '
      IF (TAKPT(2).NE.' ') GO TO 3
      IERR=2
      GO TO 13
3     IF (TAKPT(5).NE.' ') GO TO 5
      DO 4 I=4,1,-1
4     TAKPT(I+1)=TAKPT(I)
      GO TO 3
5     ENCODE (5,2,IWORD) TAKPT
      DECODE (5,6,IWORD) IV
6     FORMAT (I5)
      IF ((IV.GE.1).AND.(IV.LE.NV)) GO TO 13
      IERR=3
      GO TO 13
8     IF (TAKPT(1).NE."771004020100) GO TO 12
      TAKPT(1)=' '
9     IF (TAKPT(5).NE.' ') GO TO 11
      DO 10 I=4,1,-1
10    TAKPT(I+1)=TAKPT(I)
      GO TO 9
11    ENCODE (5,2,IWORD) TAKPT
      DECODE (5,6,IWORD) IV
      IV=-IV
      GO TO 13
12    IERR=1
13    RETURN
      END
C                                     *** STAT PACK ***
C     SUBROUTINE PART OF TRANS USED TO RETURN NEXT VALUE AND OPERATION
C     CALLING SEQUENCE: CALL COMPD(LINE,N,WORD,IDEF)
C     WHERE LINE - IS A VECTOR CONTAINING THE INSTRUCTION TYPE IN 
C                  BY THE USER.
C           N - IS A POINTER POINTING TO NEXT CHARACTER IN LINE
C           WORD - RETURN EITHER THE NEXT VARIABLE OR THE CONSTANT VALUE
C           IDEF - RETURNS THE NEXT OPERATION.  IF LESS THAN 10
C                  ITS AN OPERATION ON A VARIABLE, IF GREATER THAN 10 
C                  ITS AN OPERATION ON A CONSTANT.
C
      SUBROUTINE COMPD (LINE,N,WORD,IDEF)
      DIMENSION LINE(1),ICHAR(15),COMP(3)
      COMMON/TRNF/ITYPES(9)
      DO 1 I=1,15
1     ICHAR(I)=' '
      COMP(1)=0
      L=1
      NUM=0
      IF(LINE(N).EQ.'.') NUM=1
      IF ((LINE(N).LT.'0').OR.(LINE(N).GT.'9')) GO TO 2
      NUM=1
      GO TO 4
2     DO 3 I=1,9
      IF (ITYPES(I).NE.LINE(N)) GO TO 3
      IDEF=I
      IF (NUM.EQ.1) IDEF=IDEF+10
      GO TO 7
3     CONTINUE
4     IF (NUM.NE.1) GO TO 5
      IF ((LINE(N).GE.'0').AND.(LINE(N).LE.'9')) GO TO 5
      IF(LINE(N).EQ.'.') GO TO 5
      IDEF=80
      GO TO 7
5     IF (L.GT.15) GO TO 6
      ICHAR(L)=LINE(N)
      L=L+1
6     N=N+1
      IF (N.LT.80) GO TO 2
      IDEF=9
      IF (NUM.EQ.1) IDEF=19
7     ENCODE (15,8,COMP) ICHAR
8     FORMAT (15A1)
      IF (L.GT.1) GO TO 9
      IDEF=-IDEF
      WORD=0
      GO TO 12
9     IF (NUM.NE.1) GO TO 11
      DECODE (15,10,COMP) WORD
10    FORMAT (F)
      GO TO 12
11    WORD=COMP(1)
12    N=N+1
      RETURN
      END