
**********  FILE P0292.TSRC1 *******************************************00001000   

**********     AABCOPY       *******************************************00010000   

//HOLDEN2 JOB 'P0929EETWO,T=(,10)'                                      00020000   

/*ROUTE  PRINT ENG                                                      00030000   

//    EXEC PGM=IEBCOPY                                                  00040000   

//SYSPRINT DD SYSOUT=A                                                  00050000   

//SYSUT1 DD DSNAME=T0070.FIELD.TSRC,UNIT=2314,DISP=(OLD,KEEP),          00060000   

//    VOL=SER=ENG111                                                    00070000   

//SYSUT2 DD DSNAME=P0292.TSRC1,UNIT=2314,DISP=(OLD,KEEP),               00080000   

//    VOL=SER=666666                                                    00090000   

//SYSIN DD DUMMY                                                        00100000   

**********     C.SIMUL       *******************************************00110000   

      INTEGER*4 STABLE(50,4),ST1(50),ST4(50),IST2(50),PTS(10),MODE(10), 00120000   

     2 IFIRST,ILAST,SLOC,MINT,STEP                                      00130000   

      REAL*4 MTABLE(50,2),MTMAX(50),MTMIN(50),INTABL(10,14)             00140000   

     2,ST2(50),ST3(50),YP1(10),Y0(10),YM1(10),YM2(10)                   00150000   

     3,DYP1(10),DY0(10),DYM1(10),DYM2(10),DYM3(10),DYM4(10),DYM5(10),   00160000   

     4DYM6(10)                                                          00170000   

     5,FTIME,DTIME,DTMIN,RELERR,OUTSTP                                  00180000   

      LOGICAL CORECT                                                    00190000   

      EQUIVALENCE(INTABL(1,1),PTS(1)),(MTABLE(1,1),MTMAX(1)),           00200000   

     2(STABLE(1,1),ST1(1)),(IST2(1),ST2(1))                             00210000   

      COMMON/SIMULC/MTMAX,MTMIN,ST1,ST2,ST3,ST4,PTS,MODE,YP1,Y0,YM1,YM2,00220000   

     2DYP1,DY0,DYM1,DYM2,DYM3,DYM4,DYM5,DYM6                            00230000   

     3,IFIRST,ILAST,SLOC,FTIME,DTIME,DTMIN,RELERR,OUTSTP,MINT,CORECT,   00240000   

     4 STEP,NINT,TIME                                                   00250000   

**********     CBETA         *******************************************00260000   

C& CBETA    * * * ****                **********************************00270000   

C  CBETA CHOOSES AN APPROPRIATE BETA                                    00280000   

      SUBROUTINE CBETA(BETA)                                            00290000   

C     CHOOSES BETA FROM LIST(TABLEB) BY RETURNING (IN BETA) THE FIRST   00300000   

C                                  LARGER THAN THE SUPPLIED BETA        00310000   

C     BCODE SAME AS NCODE                                               00320000   

      REAL*4 BASEB/10.0/                                                00330000   

      INTEGER*4 BBASE/10/,POWER,CODE                                    00340000   

      INTEGER*4 NCODE,BCODE                                             00350000   

      REAL*4 TABLEN(10),TABLEB(10)                                      00360000   

      COMMON/SCALEC/TABLEN,TABLEB,NCODE,BCODE                           00370000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    00380000   

     2,ICODE,NMBIAS                                                     00390000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       00400000   

     2,RFVOLT,ICODE,NMBIAS                                              00410000   

      POWER=0                                                           00420000   

      CODE=IABS(BCODE)                                                  00430000   

      TEMP=BETA                                                         00440000   

      IF(BETA.LT.TABLEB(1))GOTO21                                       00450000   

CCCC  BETA GT OR EQ FIRST ELEMENT IN TABLEB                             00460000   

10    FACTOR=BBASE**POWER                                               00470000   

      DO 12 I=1,CODE                                                    00480000   

      BETA=TABLEB(I)*FACTOR                                             00490000   

      IF(TEMP.LE.BETA)RETURN                                            00500000   

12    CONTINUE                                                          00510000   

      IF(BCODE.LT.0)RETURN                                              00520000   

      POWER=POWER+1                                                     00530000   

      GO TO 10                                                          00540000   

21    TEMP1=TABLEB(1)                                                   00550000   

      IF(BCODE.LT.0)GO TO 30                                            00560000   

25    POWER=POWER-1                                                     00570000   

      FACTOR=BASEB**POWER                                               00580000   

      DO 27 I=1,CODE                                                    00590000   

      BETA =TEMP                                                        00600000   

      TEMP1=TABLEB(CODE+1-I)*FACTOR                                     00610000   

      IF(TEMP.GT.TEMP1)RETURN                                           00620000   

27    CONTINUE                                                          00630000   

      GO TO 25                                                          00640000   

30    BETA=TEMP1                                                        00650000   

      RETURN                                                            00660000   

      END                                                               00670000   

$ENTRY                                                                  00680000   

**********     DATAQ         *******************************************00690000   

$JOB   MAIN1     T0173FIELD.HOLD,KP=29,P=99,RUN=F,T=(,10)               00700000   

   TITLE/ SINE GENERATOR WITH AMPLITUDE CORRECTION CIRCUIT              00710000   

   DIAGRAM                                                              00720000   

C     THE INFINITE SINE GENERATOR                                       00730000   

      INT1 /IN=P3,MUL9,OUT=X:1,IC=P1,MAX=1.0                            00740000   

      INT2 /IC=-P2*0.6,OUT=-X,MAX=1.0,IN=INT1                           00750000   

      P2  /IN=N.REF*0.707,OUT=-A                                        00760000   

      SQ7  /IN=P2, OUT=A..2                                             00770000   

      SUM8 /IN=DIV6,N.REF                                               00780000   

      MUL9 /IN=INT1,SUM8                                                00790000   

      SQ3 /IN=INT2                                                      00800000   

      NEG4 /IN=SQ03, OUT=X..2                                           00810000   

      SQ5  /IN=INT1                                                     00820000   

      SUM0 /IN=SQ5,NEG4 'OUT=X:2**2-X**2'                               00830000   

      P1 / IN = P.REF*0.5                                               00840000   

      DIV6 /IN=SUM0,SQ7                                                 00850000   

      NEG10 /IN=INT2,OUT=X                                              00860000   

      P3   /IN=NEG10*.333  'IT IS COEFFICIENT B'                        00870000   

   OUTPUTS                                                              00880000   

      JIFFY                                                             00890000   

   SIMULATE                                                             00900000   

      TIME=20.0,DELTA.T=0.01,MIN.DELTA=0.00001,REL.ERROR=0.001          00910000   

      INTEGRATOR= RUNGE.K                                               00920000   

   END                                                                  00930000   

      OUTPUTS=(MAX.MIN),X,X:1,T                                         00940000   

      OUTPUTS=T,X,A                                                     00950000   

$IBSYS                                                                  00960000   

$STOP                                                                   00970000   

**********     DEBBE         *******************************************00980000   

\\\\\\\\\\\\ \\&\\\- \\&                                                00990000   

\\\y \\&\\\0 \\&\\\\\\\&\\K\\\\\\\\\\0\\        q\\\\0\\    \\\\\\\\K\q\01000000   

\\\9\\\\\\\\\\\\\\\\\U\\\&\\\\\\\\\\\w0900\\\\\\\\\\\\K9\\\\K\\\\\k\\[K\01010000   

\&q\\\\\\\\\\\q\j\\\\]q\K\\\q\b\q\nXqW\\qDnNqW\\q\nFqW\\q\K\\\\\k \\P\\\01020000   

\\\\\\ \\\ \\\K\\\q\K\q\\\k\q\K\\\q\b\q\K\\\q\N\\\q\\\q\K\\\\\\\qYb\\\n\01030000   

q\\\q\\\q\\\\\q\\\qYK\\\q4\0q\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\01040000   

 PHASE SYSSUP,A,0                                                       01050000   

\ESD      \\  \\        4\\\ \\%                                        01060000   

\TXT \\\  \\  \\\\\\\\\\\\\\\\\\\\\\\\\8\\\\0\\\\\\\\\\>\q\\\\\\\\\\\\\\01070000   

\TXT \\\  \\  \\\\\\\\\\\\\\\\\0                                        01080000   

\TXT \\\  \\  \\\\\\\\\\\\\\\\\\\\\\\\\+                                01090000   

\TXT \\\  \\  \\\\K\\\\\\0\\                                            01100000   

\TXT \\\  \\  \\\\\\n\\\\ \\\\\\n\\\\\\\K\\\\\\\\\\\\\&\\\\\\\\\&\\Qn\\[01110000   

\TXT \\\  \\  \\\\\\k0\3k\\\nA\\\\\\k-\\k\\\K\\\\\\\\\&\\%\\\\&\\H\\\\\\01120000   

\TXT \\<  \\  \\\\\Hj\\\\\\\K\\\\\k\\\o\\\b\\\q\\ym\\\K\\\\\m"\\\0\>n\\\01130000   

\TXT \\d  \\  \\\\\\k\\\K\\\\\\0\8                                      01140000   

\TXT \\q  \\  \\\\\\\\\\\\\0\\\\\\\\000\NAMEXX\\\\\\\\\\\\\\\\\\        01150000   

\TXT \\\  \\  \\\\\\\\\\&0\\k\\\\\\\j\\\\\\]\\\\j \\\\\\!0\\\0\Mo0\Zk\\D01160000   

\TXT \\\  \\  \\\0\H\0\\\\\\\]\\\\N\\\\\K\\\\q\\\\\0\\n\\\\\\+n \\\\\\  01170000   

\TXT \\\  \\  \\K\\\\\k \\nA\\k \\\\\!\\\QK\\\\\j0\\\]\\m\\\n\\\\ \\n\\\01180000   

\TXT \\\  \\  \\\\\\\\\=o\\\k \\m\\\j\\\\\\\\\\\K\\\\\\0\2b\\\m\\\\0\=\\01190000   

\TXT \\\  \\  \\ \\\\4K\\\\\\\\y\\0702A n2\A\\\\n3\A\\\\n \A\\\\\\\\\\  01200000   

\TXT \\]  \\  \\\\\\ \\\k\\\m\\\o0\\b\\\\\\\n\\\\\\\K\\\\\ \\\k\\\b\\\\\01210000   

\TXT \\\  \\  \\0701  \\k \\k \\\0\\SYSEOJ\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\01220000   

\TXT \\&  \\  \\\a\\\b\\\c\\\d\\\\\\*\K\\>\\\\\%\\\\ \\\M\\\\\j\\\\\\\  01230000   

\TXT \\f  \\  \\ \\\K\\*\;\\\\\\\\\\\\o\\\\\\on\\\\\\\\\\\\\\y\0\uK\\\\>01240000   

\TXT \\\  \\  \\n\G\\\\\K\\\\\K\\>Go\\\%K\\[\\\\\\n\L\\\\\m\\YO\\YL\    01250000   

\TXT \\2  \\  \\K\\2\[K\\[\6\\\\\0\\k0\xk\\\\\\\\-\\\\\\ \\\\\\\ \\\\\\\01260000   

\TXT \\\  \\  \\\\\\m\\\j\\\\\\\ju\\\&\\\0\2\0\\b\\\k0\\\\\\\\\\\0\\k\\301270000   

\TXT \\\  \\  \\K\\\\\P\\\\\o0\\\\\[N\G\\\\\\\K\\>Go\\\%j\\\\\\\j\\\\\\\01280000   

\TXT \\\  \\  \\o\\\j\\\\\\\\\\\j\\\\\\\o\\\j\\\\\\2O\\\\\o\\\k\G\K\Go\\01290000   

\TXT \\K  \\  \\K\\\\\\0\\n\Go\-\\N\\o\q\\\2m"\\\0\;b\\\P\\o\oK\\\\\k\\\01300000   

\TXT \\\  \\  \\k\\xk\\\k0\\k0\\k0\\n\\\\\q\\\k\\\\\o\\\j\\\\\\\\\\[\\\\01310000   

\TXT \\\  \\  \\q\\\k\\\k0\\k\\\k\\\\\\\\\\y.\\O \\\K\\\\ P\\\\\\\\\    01320000   

\TXT \\\  \\  \\K\\[\m\\\\\-\@\\\\\\\dK\\ \\\\\\\h\\\\\\\\\\\h\\\h\\\8  01330000   

\TXT \\\  \\  \\k\\\b\\\k\\\\\\%o\\\j\\\\\\\j\\\\\\\\0\\3\\\\\3\\\\\    01340000   

\TXT \\]  \\  \\\\\\\\K\\8\\K\\\\\\\\]\\CHUN  \\SENSA q\\]}\\\\\\\n5\\  01350000   

\TXT \\\  \\  \\\\\\n4\\\\\2m\\\n\\\k0\\\\\\\\\\\\\\\\\%\0\w\0\-k\\\    01360000   

\TXT \\[  \\  \\K\\[\\\\\\k\\\k\\\\0\\j0\\\\\\ \\\ \\\\\\[\\\2j\\\\\\\  01370000   

\TXT \\\  \\  \\N\\\\\\\\\\0\\\\\!j\\\\\\0\\\\n\\\\\\\}\\h\\\0K\\>\\\\\%01380000   

\TXT \\\  \\  \\\\\\N\L\\\\\\\k0\xk0\\\\\%o\\\\0\\k\\\.\\\K\\\\\n\\\\\\\01390000   

\TXT \\0  \\  \\n\\\\\\\m\\\\\\[j\\\\\\\n\\\\\\\3\\\\\\\\\\\K\\\\\&\\]\\01400000   

\TXT \\\  \\  \\CHUN  \\0700A \\\\\\\]n\G\\ \2\0\\ \\\\\\\\\\\\0\\\\\\\\01410000   

\TXT \\-  \\  \\\\\\\\\\\\\\\\\\\\\\\\\\\q\\\\\\\>\;\\\\\\\\\\\\\\\;\8\\01420000   

\TXT \\q  \\  \\\\\\\\\\\\\\\\\\                                        01430000   

\TXT \\y  \\  \\\\\\                                                    01440000   

\TXT \\Y  \\  \\\\\Y-\\&\\\\\\\Y\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\M\\\\01450000   

\TXT \\\  \\  \\0123456789ABCDEFj\\\\\j \\\\\\j\\\\a\\\\j\\\\\j\\\\\\\  01460000   

\TXT \\\  \\  \\j\\\\\\\j\\\\\\>o\\\\0\\\\\\o\\\\2\\\\j\\\\\\\o\\\\2\4  01470000   

\TXT \\\  \\  \\n\\\\C\4                                                01480000   

\TXT \\q  \\  \\j\\\\bk\a j\\\\&a\\\\\J\a\\\m\a\j\\\\\\\j\\\\\a\o\\\\2  01490000   

\TXT \\\  \\  \\n\a\\\\\k\a j\\\\\\wj\\\\\\\\#\\\\\y.\\\\-\\\\\ \-n\a\  01500000   

\TXT \\\  \\  \\\\\Dj\\\\\\Mj\\\\\\w\\\\\\\\\\\-\\\-\\\\\\\\\\\0\w\v\Q  01510000   

\TXT \\\  \\  \\k\a n\\\\\\\\v\Q\0\%j\\\\\o\\\\0\\\v\\n\\\\\k3\\\1k\a   01520000   

\TXT \\\  \\  \\\-\\\\a\\v\Q\v\]j\a\\\\4\-\]p\a \\\c\v\Q\\\\\0\%n\\\\\  01530000   

\TXT \\w  \\  \\j\\\\\n\a\\\\0\wn\a\\a\4                                01540000   

\TXT \\\  \\  \\\\\\-\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\Y\\\\\\              01550000   

\TXT \\0  \\  \\&\\\\\\\\\j\\D\\\\j\\E\\\\\0\\\0\\\\\O\]\\\0\\\\\\\0\\  01560000   

\TXT \\\  \\  \\\\\;\0\K\\\\\0\@\\\\\\\0\0\(K\]\\b\0\\n \\\\\\\\\\\\\\\\01570000   

\TXT \\;  \\  \\\\\\\\\\\&                                              01580000   

\TXT \\\  \\  \\\\\\\\\-\END\XFR\TXTK\\\\\k\\\\\\,n0\\\ \\n9\\\\\\\\230001590000   

\TXT \\0  \\  \\A \0\\nA\\\ \4nF\\\\\4\\\\\\\\}\\%\\\U\\\\2\\\\\\]\'\0\b01600000   

\TXT \\\  \\  \\\\\\K\\\]\k0\\\0\]2\0\\\\\\\n,]\\\\\.0\\\]\\\0\\        01610000   

\TXT \\\  \\  \\\REP\\\\\\\$\\\\\\\\                                    01620000   

\XFR \\q      \\                                                        01630000   

\RLD      \\    \\\\\\\*\\\\\\\\\\\\\\\%\\\\\\\@\\\\\\\\\\\\\\\b\\\\\\\\01640000   

\RLD      \\    \\\\\\\D\\\\\\\[\\\\\\\s\\\\\\\A\\\\\\\\\\\\\\\\\\\\\\\\01650000   

\RLD      \\    \\\\\\\\\\\\\\\:\\\\\\\@\\\\\\\=\\\\\\\\\\\\\\\b\\\\\\\d01660000   

\RLD      \\    \\\\\\\f\\\\\\\h\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\k01670000   

\RLD      \\    \\\\\\\m\\\\\\\\\\\\\\\Z\\\\\\\4\\\\\\\\\\\\\\\\\\\\\\\\01680000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\;\\\\\\\:\\\\\\\=01690000   

\RLD      \\    \\\\\\\o\\\\\\\\\\\\\\\8\\\\\\\/\\\\\\\\\\\\\\\\\\\\\\\\01700000   

\END                                                                    01710000   

\ESD      \\  \\DEBE    0\\\ \\\                                        01720000   

\TXT \\\  \\  \\                                                        01730000   

\TXT \\\  \\  \\\\\8\\\\\\\\\\\\\\\\\\\\\\\8\\\\\00\ \0\\\\\j\0\\\0\\0]\01740000   

\TXT \\\  \\  \\\\\\\\\\\\f\\\\8\\\\\                                   01750000   

\TXT \\+  \\  \\\00\\\\ j\0\\\0\j\0\\\0\\\0\K^0%\\K\0\0\\0]\\\4001A     01760000   

\TXT \\b  \\  \\K\0\0\\\\ j\0\\\0&K\0\0\\00\\\\\\\\\\y                  01770000   

\TXT \\8  \\  \\\\\\\\\&\\\\\\\\\\d\\\\\\\\\\                           01780000   

\TXT \\\  \\  \\\002j\0\\\0\O\1\0\j\0\\\0\O\1\0\K\0\0\K\0\0+\\\\j\0\\\0\01790000   

\TXT \\+  \\  \\\0]\\\\\\\\\\\\\\d\00yj\0\\\0-O\1\0\j\0\\\0>O\1\0\K\0\]\01800000   

\TXT \\f  \\  \\n\0\\\0ok\1\m90\m90\\\\s\0]\\\d\\\\\\\\\\\\\\-\\\&\     01810000   

\TXT \\\  \\  \\\00+\\]\K\0I]\\]]\j\1\k\1\\\j\0\\\0Kj\0\\\0\m90\m90\\\\\01820000   

\TXT \\2  \\  \\\\\8\\\\d\\\\\\\\\\\\&\\\\\\\\\\\\\\\\\\\\y\\\\\\\\\\\\\01830000   

\TXT \\\  \\  \\\\\\\                                                   01840000   

\TXT \\\  \\  \\\00\\\\\j\0\\\0\j\0\\\0\\\0\.\0\\0]\&]0\\\0&\\\\\\\8\]0\01850000   

\TXT \\\  \\  \\\00\o00\\0]\\\\\\\\\\\\\\\\8\\\\\00do\0\m70\m\0\\00\\00\01860000   

\TXT \\\  \\  \\j\0S\\0\k\0\K\0Y]\n\0Y\ 0\k 0\\\\0n\]\\\]\j\0S\\0\j\0T  01870000   

\TXT \\O  \\  \\\\]\\]08\\0M\\\\\8\]08\00\\\\\\\\8\\\\\\\&\\\\\\\&\\\\\\01880000   

\TXT \\\  \\  \\\\\\\8\\\\\\\hh\\\\\\\\\\\\\\\\\\                       01890000   

\TXT \\\  \\  \\\00\\\0\ \0=\\\\j\0\\\0\j\0\\\0\o00\\0]\m\0\&]0\m70\\\0*01900000   

\TXT \\\  \\  \\\\\\\\\8\]0\\00\o00\\0]\\\\\\\\\\\\8\\\\\00-o\0\m70\m\0\01910000   

\TXT \\\  \\  \\j\0\\\0\\00\\00\j\0H\\0\k\0MK\0\]\n\0\\ 0\k 0M\\\O\0]\\\01920000   

\TXT \\Q  \\  \\\\\\\]\\\\\\\\\&\\\\\\\&\\\\                            01930000   

\TXT \\4  \\  \\\\\\\\\\&]\\K\\W0\K\\5\\j\0\\]\\\]\\[]\Wk\\\O\\\]\p\\\  01940000   

\TXT \\\  \\  \\j\0\\\\\k\\4\]\Dj\0\\\\\k\\4\]\Dj\\\\\\\\\4884A \0\+j\0\01950000   

\TXT \\\  \\  \\\]\\k\\4k\\U\]\Dk\\Uj\\V\\\\N\\\\\\\\\k\\4\]\D\0\\k\\4  01960000   

\TXT \\q  \\  \\k\\\\]\D\0\Fj\0\\\\\k\\4\]\DP\0\0\j\0\\\\Uj\0\\\\0\]\\  01970000   

\TXT \\\  \\  \\o\0\m\0\\\j\0\\\\\\0\0p\0\\]\\n\]\\\\\\0]\              01980000   

\TXT \\8  \\  \\\\\\&]\\K\\W0\K\\5\\\]\\[]\Wk\\\O\\\]\p\\\j\0\\]\uj\0\  01990000   

\TXT \\\  \\  \\\\\\j\0\\]\dj\0\\\\\\]\\j\0\\\\@j\0\\]\o\\\\K\0\0\ \\\  02000000   

\TXT \\\  \\  \\\]\\\\\\\0\\p\0\\0\\j 0\\\\\o\0\\\\\\\j\0\\\\wk\\4\]\D\\02010000   

\TXT \\\  \\  \\4132A \0\\                                              02020000   

\TXT \\y  \\  \\EFEV\\\\\\\\\\\#n\\4\\\\k\\8\\\Oj\\U\\\Mk-\8\\\\\\\\\]\\02030000   

\TXT \\]  \\  \\\\\\ \\\\\\\-\\\\\\\\\\&\\\\&]\\j\0\\]\\k\\4\]\D\]\\\\  02040000   

\TXT \\\  \\  \\k\\4\]\D\0\\\\\\\\VOL10                                 02050000   

\TXT \\\  \\  \\\\\\\\\\\\\\&]\\j 0\\]\;\\\\\\\\]\j\0\\]\\j\0\\]\\K\\W0\02060000   

\TXT \\\  \\  \\\]\\[]\Wk\\\O\\\]\p\\\K\\5\\j\0\\]\uj\0\\\\\\0\\k\\4\]\D02070000   

\TXT \\\  \\  \\j\0\\]\\k\\4\]\D\\4140A \0\\j\0\\\\\k\\4\]\D\0\\j 0\\]\002080000   

\TXT \\Q  \\  \\k\\4\]\D\0\\j\0\\\\Uj\0\\]\\\\\\K\0\0\ \\\j\0\\\\H\]\\  02090000   

\TXT \\\  \\  \\j\0\\]\\p\0\\]\\n\]\\\\ \0]\\\\\\4\\\0\\\\\ \\K\ \\\j\\\02100000   

\TXT \\\  \\  \\\\\\\\\@K\\\\\\0\\K\w\v\\\\\\0\\\\\\\\\\\\ \u\\ us\-\\\\02110000   

\TXT \\=  \\  \\\&w\\\\\}\v\\\\;g\\+\0\\\\u0\\v\\3\\}\v\\\\;g\\\\0\\\\\\02120000   

\TXT \\\  \\  \\\\\\u\\\\0\\\\\\\+\0\\k vYK+vZvY\0\u\\\\\+\0\\}&v\\\\>  02130000   

\TXT \\\  \\  \\}&v\\\\6\0\mk w\Kbw\w\\\u\K^w\vY\\\0\\\\\\\\\\\0\Y\\\\\\02140000   

\TXT \\\  \\  \\\\\\\\\0\\\0\\\\\\\-\\\0\\\\t!\\\&\\u\K^w\vY\\\0\\\\\\\\02150000   

\TXT \\*  \\  \\\0\\\\t<k w\K+wAw\\0\\\\\\\\K^vYw\\0\<\\\\\+\0\\}&v\\\\m02160000   

\TXT \\m  \\  \\}&v\\\\>\0\6\\t!\\\0\\\\\\\\\\\0\\\\t<}&v\\\\\\0\\\\\\\\02170000   

\TXT \\\  \\  \\\\\0\\\0\\\\\\\\\\\0\\\\t<K\w\v\\\\\\\\0\\\\\\\\\\\\ \u\02180000   

\TXT \\\  \\  \\\ us2\v]w\^-v]}&v\\\\6\0\Y\\\\\\\\\-\S\0\\\0\\\\\\\\\\  02190000   

\TXT \\\  \\  \\\-\6\0\\\\t!\\t<\0s\\\\\\\\\\0s\\\\\\\\0s\\\t<\\\0s\\\\\02200000   

\TXT \\\  \\  \\\-\\\\v'v'\\\0s<\\\\\\k w\Kbw\w\K\w\v\+\v]\\w\vV\\v'v\  02210000   

\TXT \\y  \\  \\\\w\v'\\\ \\\\\ w\\\\\sH[\vO\0sH\0s\k\0\\0s\\\\\\\\0sy\\02220000   

\TXT \\]  \\  \\\\\\\\\0s\\\\\\\\\\\\\k w\Kbw\w\3Xw\ \3Xw\ \3Xw\ \3Xw\ \02230000   

\TXT \\\  \\  \\3Xw\ \3Xw= \3Xw\ \3\w\ \\\w\u\[ vMK\w\\ \\s\\\\\t\\\\\\\02240000   

\TXT \\&  \\  \\[\vQ\\t\k \\K\\\\\\\\0t\k\0\\0t\\\\\\\\0t\\\\\\\\0s\    02250000   

\TXT \\d  \\  \\K\w\va\ \\\0t\K\w\v\\ \\\\\\\\\0t\\\\\\\\\\\ \u\\\\ us\\02260000   

\TXT \\\  \\  \\[ \\\-wAj0wA\\tq[-vK\-\\\-w\j0w\\\t\[-vK\-\\\\\\\-wDj0wD02270000   

\TXT \\4  \\  \\\\tD[-vK\-\\\-wCj0wC\\tQ[-vK\-\\\-wBj0wB\\t\[-vK\-\\h\\\02280000   

\TXT \\\  \\  \\ \\\\9\\t<\\v'v'\\\0u\\\\\\\k w\Kbw\w\K\w\v\+\v]\\w\vV  02290000   

\TXT \\\  \\  \\\\v'v\\\w\v'\-w\}\v\\ u\K\w\-\\\\0u&\\\\\\\\\0u*\\\\\\\\02300000   

\TXT \\\  \\  \\\\\\.\v\k w\Kbw\w\\\uk[-v\\0u\\\\\u\\0u[K\w\-\\\\0uq\\\\02310000   

\TXT \\K  \\  \\\-\\\0u\\\\\j\uS\\uwj\uT\\us\4\\\\j\u\\\u\j\uJ\\\\\9\\\\02320000   

\TXT \\\  \\  \\\\\\\\\\\\\\\&\\\\\\\\\\\8\\\\\\\8\\\-\\\\\\\S\\\\\\\SEN02330000   

\TXT \\\  \\  \\T PROG ID - XXCCCPCTTCTTTPWTSRSFTDRWBScccpcttctttpwtsrsf02340000   

\TXT \\:  \\  \\tdrwbsENT NR REC TO BE SKIPPED -XXXXREC \\\\\, LENGTH \\02350000   

\TXT \\\  \\  \\\\\\\\\ENT ADDR OF INPUT TAPE - MMAAAENT ADDR OF OUTPT T02360000   

\TXT \\\  \\  \\APE - MMAAA0123456789ABCDEF\\\\\\\\\\\\\                02370000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02380000   

\RLD      \\    \\\\\\\\\\\\\\\}\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\u\\\\\\\902390000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02400000   

\RLD      \\    \\\\\\\y\\\\\\\\\\\\\\\4\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02410000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\-\\\\\\\a02420000   

\RLD      \\    \\\\\\\\\\\\\\\U\\\\\\\6\\\\\\\9\\\\\\\\\\\\\\\\\\\\\\\\02430000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\%\\\\\\\i02440000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\Z\\\\\\\0\\\\\\\\\\\\\\\\02450000   

\RLD      \\    \\\\\\\F\\\\\\\\\\\\\\\\\\\\\\\Z\\\\\\\1\\\\\\\\\\\\\\\\02460000   

\RLD      \\    \\\\\\\D\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02470000   

\RLD      \\    \\\\\\\\\\\\\\\d\\\\\\\\\\\\\\\H\\\\\\\Q\\\\\\\8\\\\\\\\02480000   

\RLD      \\    \\\\\\\\\\\\\\\&\\\\\\\*\\\\\\\\\\\\\\\d\\\\\\\M\\\\\\\]02490000   

\RLD      \\    \\\\\\\\\\\\\\\0\\\\\\\\\\\\\\\@\\\\\\\y\\\\\\\\\\\\\\\h02500000   

\RLD      \\    \\\\\\\m\\\\\\\q\\\\\\\\\\\\\\\\\\\\\\\2\\\\\\\\\\\\\\\\02510000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02520000   

\RLD      \\    \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\02530000   

\RLD      \\    \\\\\\\\                                                02540000   

\END \\\      \\                                                        02550000   

**********     DKTODK        *******************************************02560000   

//HOLDEN   JOB 'T0173FIELD.HO,T=(,10)',MSGLEVEL 1                       02570000   

// EXEC  PGM=IEHMOVE                                                    02580000   

//SYSPRINT DD SYSOUT=A                                                  02590000   

//SYSUT1   DD UNIT=2314,VOL=SER=777777,DISP=(NEW,DELETE,DELETE),       X02600000   

//             SPACE=(TRK,(100,10))                                     02610000   

//DD1      DD UNIT=2314,VOL=SER=ENG111,DISP=SHR                         02620000   

//DEST1    DD UNIT=2314,VOL=SER=666666,DISP=SHR                         02630000   

//SYSIN    DD *                                                         02640000   

//* COPY PDS=T0173.FIELD.SRC,FROM=2314=ENG111,TO=2314=666666,          X02650000   

               RENAME=T0173.SRC1                                        02660000   

//* COPY PDS=T0173.FIELD.TSRC,FROM=2314=ENG111,TO=2314=666666,         X02670000   

               RENAME=T0173.TSRC1                                       02680000   

/*                                                                      02690000   

**********     DKTOTP        *******************************************02700000   

//HOLDEN   JOB 'T0173FIELD.HO,T=(,19)',MSGLEVEL=1,CLASS=T               02710000   

// EXEC  PGM=IEHMOVE                                                    02720000   

//SYSPRINT DD SYSOUT=A                                                  02730000   

//SYSUT1   DD UNIT=2314,VOL=SER=777777,DISP=(NEW,DELETE,DELETE),       X02740000   

//             SPACE=(TRK,(100,10))                                     02750000   

//DD1      DD UNIT=2314,VOL=SER=ENG111,DISP=SHR                         02760000   

//TAPE     DD UNIT=2400,VOL=(PRIVATE,RETAIN,SER=HOLDEN),DISP=(NEW,KEEP) 02770000   

//SYSIN    DD *                                                         02780000   

//* COPY PDS=T0173.FIELD.SRC,TO=2400=(HOLDEN,1),TODD=TAPE               02790000   

//* COPY PDS=T0173.FIELD.TSRC,TO=2400=(HOLDEN,2),TODD=TAPE              02800000   

/*                                                                      02810000   

**********     DUMMY         *******************************************02820000   

C& DUMMY                                                                02830000   

C  DUMMY PROGRAMME TO REDUCE COMPILE TIME                               02840000   

      SUBROUTINE DUMMY                                                  02850000   

C     PRINT A MESSAGE                                                   02860000   

      PRINT,'***********************WHERE"S THE SUBROUTINE *********'   02870000   

C     LET'S CAUSE AN ERROR                                              02880000   

      X=X                                                               02890000   

      STOP                                                              02900000   

      END                                                               02910000   

$ENTRY                                                                  02920000   

**********     DUPLC         *******************************************02930000   

C&  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02940000   

C   DUP                                                                 02950000   

C     THIS PROGRAMME DUPLICATES CARD DECKS AND ADDS SEQUENCE NUMBERS    02960000   

C     THE SEQUENCE NUMBERS ARE OF THE FORM 'ABCDNNNN' WHERE ABCD IS A   02970000   

C      FOUR CHARACTER NAME AND NNNN IS A FOUR DIGIT NUMBER (WITH ALL    02980000   

C      ZEROS INCLUDED) WHICH IS INCREMENTED BY TEN FOR EACH CARD        02990000   

C     THE NAME MAY BE SPECIFIED BY INCLUDING IN THE DATA THE            03000000   

C      FOLLOWING TWO CARDS                                              03010000   

C&                                                                      03020000   

C  NAME                                                                 03030000   

C     INCLUDE THE 'C'S IN COLUMN 1 THE NAME STARTS IN COLUMN 4          03040000   

C     THE NAME SPECIFYING CARDS ARE INCLUDED IN THE SEQUENCED OUTPUT    03050000   

C     THE NAME MAY BE SPECIFIED ANY NUMBER OF TIMES BUT THERE MUST      03060000   

C      NOT BE MORE THAN 999 CARDS BETWEEN NAME IDENTIFIERS              03070000   

      INTEGER*2 ALPHA(80),NUMB(4),CARRY                                 03080000   

      INTEGER*4 IUNIT/5/,OUNIT/6/,NAME/' ABC'/,TEST/'C & '/,SIGN        03090000   

     2,END/'C . '/                                                      03100000   

      EQUIVALENCE(SIGN,ALPHA(1))                                        03110000   

      OUNIT=7                                                           03120000   

2     CONTINUE                                                          03130000   

      DO 1 I=1,4                                                        03140000   

1     NUMB(I)=0                                                         03150000   

      IC=0                                                              03160000   

3     CONTINUE                                                          03170000   

      READ(IUNIT,21) (ALPHA(I),I=1,80)                                  03180000   

      IF(TEST.EQ.SIGN)GO TO 50                                          03190000   

      IF(SIGN.EQ.END) GO TO 70                                          03200000   

      CARRY=1                                                           03210000   

      IC=IC+1                                                           03220000   

      DO 10 I=1,3                                                       03230000   

      K=4-I                                                             03240000   

      N=NUMB(K)+CARRY                                                   03250000   

      CARRY=N/10                                                        03260000   

      NUMB(K)=N-CARRY*10                                                03270000   

10    CONTINUE                                                          03280000   

      IF(CARRY.EQ.1)STOP                                                03290000   

      WRITE(OUNIT,31) (ALPHA(I),I=1,72),NAME,(NUMB(I),I=1,4)            03300000   

      GO TO 3                                                           03310000   

50    CONTINUE                                                          03320000   

      WRITE(6,51) NAME,IC                                               03330000   

      READ(IUNIT,52) NAME,(ALPHA(I),I=8,80)                             03340000   

      WRITE(OUNIT,61) NAME                                              03350000   

      WRITE(OUNIT,62)NAME,(ALPHA(I),I=8,72),NAME                        03360000   

      GO TO 2                                                           03370000   

70    WRITE(6,51) NAME,IC                                               03380000   

      STOP                                                              03390000   

21    FORMAT(80A1)                                                      03400000   

31    FORMAT(    72A1,A4,4I1)                                           03410000   

51    FORMAT(3X,A4,I6)                                                  03420000   

52    FORMAT(3X,A4,73A1)                                                03430000   

61    FORMAT('C&  ',34('* '),A4,'0000')                                 03440000   

62    FORMAT('C  ',A4,65A1,A4,'0001')                                   03450000   

      END                                                               03460000   

**********     FILENME       *******************************************03470000   

C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03480000   

C&                                                                      03490000   

C  INIT                                                                 03500000   

      SUBROUTINE INITAL                                                 03510000   

      INTEGER*4 SPOSN,PSPOT,PTAB,INT/1/,             RUN/0/,POINT       03520000   

     2,PREF/18000/,NREF/19000/                                          03530000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    03540000   

     2,ICODE,NMBIAS                                                     03550000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       03560000   

     2,RFVOLT,ICODE,NMBIAS                                              03570000   

      INTEGER*4 STABLE(50,4),ST1(50),ST4(50),IST2(50),PTS(10),MODE(10), 03580000   

     2 IFIRST,ILAST,SLOC,MINT,STEP                                      03590000   

      REAL*4 MTABLE(50,2),MTMAX(50),MTMIN(50),INTABL(10,14)             03600000   

     2,ST2(50),ST3(50),YP1(10),Y0(10),YM1(10),YM2(10)                   03610000   

     3,DYP1(10),DY0(10),DYM1(10),DYM2(10),DYM3(10),DYM4(10),DYM5(10),   03620000   

     4DYM6(10)                                                          03630000   

     5,FTIME,DTIM ,DTMIN,RELERR,OUTSTP                                  03640000   

      LOGICAL CORECT                                                    03650000   

      EQUIVALENCE(INTABL(1,1),PTS(1)),(MTABLE(1,1),MTMAX(1)),           03660000   

     2(STABLE(1,1),ST1(1)),(IST2(1),ST2(1))                             03670000   

      COMMON/SIMULC/MTMAX,MTMIN,ST1,ST2,ST3,ST4,PTS,MODE,YP1,Y0,YM1,YM2,03680000   

     2DYP1,DY0,DYM1,DYM2,DYM3,DYM4,DYM5,DYM6                            03690000   

     3,IFIRST,ILAST,SLOC,FTIME,DTIM ,DTMIN,RELERR,OUTSTP,MINT,CORECT,   03700000   

     4 STEP                                                             03710000   

      INTEGER*4 PTABLE(4,50),PNEXT,ITABLE(2,150),IPOSN,OTABLE(6,50)     03720000   

     2,OPOINT                                                           03730000   

      REAL*4 TABLEI(2,150),TABLEO(6,50)                                 03740000   

      COMMON/TABLES/PTABLE,PNEXT,ITABLE,IPOSN,OTABLE,OPOINT             03750000   

      EQUIVALENCE(ITABLE(1,1),TABLEI(1,1)),(OTABLE(1,1),TABLEO(1,1))    03760000   

      INTEGER*4 TPOINT(10),TFACT(10)                                    03770000   

      EQUIVALENCE(TPOINT(1),Y0(1)),(TFACT(1),YM1(1))                    03780000   

      INTLOC=0                                                          03790000   

C     CHECK FOR FIRST RUN                                               03800000   

      IF(STEP.NE.0)GO TO 40                                             03810000   

C     SET UP INTEGRATOR TABLE AND INITIALIZE REFERENCE VOLTAGES         03820000   

      PSPOT=0                                                           03830000   

30    PSPOT=PSPOT+1                                                     03840000   

      PTAB=PTABLE(1,PSPOT)                                              03850000   

CDUM  PRINT,'  PSPOT = ',PSPOT,'    PTAB = ',PTAB                       03860000   

C     CHECK FOR END OF PRE-INITIALIZING                                 03870000   

      IF(PTAB.EQ.0)GO TO 39                                             03880000   

C     INIT THE REF VOLTAGES                                             03890000   

      IF(PTAB.EQ.NREF.OR.PTAB.EQ.PREF)GO TO 70                          03900000   

C     AND SETUP INTEGRATOR POINTERS                                     03910000   

      IF(PTAB/NMBIAS.NE.INT)GO TO 30                                    03920000   

      CALL SSCAN(PSPOT,SPOSN)                                           03930000   

C     CREATE A POSITION IN INT.TABLE FOR INTEGRATOR                     03940000   

      INTLOC=INTLOC+1                                                   03950000   

      IST2(SPOSN)=INTLOC                                                03960000   

C     ENTER FORWARD & BACKWARD POINTERS BETWEEN INT & S .TABLES         03970000   

      PTS(INTLOC)=SPOSN                                                 03980000   

      MODE (INTLOC)=RUN                                                 03990000   

C     SET MODE OF INTEGRATORS TO 'RUN'. WHY NOT?                        04000000   

C     RUN=0,HOLD=-1,IC=1                                                04010000   

      GO TO 30                                                          04020000   

C     MARK END OF INT.TABLE                                             04030000   

39    PTS(INTLOC+1)=0                                                   04040000   

C     NOW FIND OUT WHERE THE IC'S ARE                                   04050000   

40    ILOC=0                                                            04060000   

41    ILOC=ILOC+1                                                       04070000   

      POINT=PTS(ILOC)                                                   04080000   

CDUM  PRINT,'   ILOC = ',ILOC,'    POINT = ',POINT                      04090000   

      SPOSN=0                                                           04100000   

      FACTOR=0.0                                                        04110000   

C     TEST FOR END OF INT.TABLE                                         04120000   

      IF(POINT.EQ.0)GO TO 47                                            04130000   

      IFIRST=PTABLE(2,ST1(POINT))                                       04140000   

      IF(IFIRST.EQ.0)GO TO 46                                           04150000   

      ILAST=ITABLE(1,IFIRST)-ICODE+IFIRST-1                             04160000   

42    IFIRST=IFIRST+1                                                   04170000   

C     SCAN TO FIND I.C. , IT IS A NEGATIVE ENTRY                        04180000   

      IF(ITABLE(1,IFIRST).LT.0)GO TO 45                                 04190000   

43    IF(IFIRST.LT.ILAST)GO TO 42                                       04200000   

      GO TO 46                                                          04210000   

45    NAME=IABS(  ITABLE(1,IFIRST))                                     04220000   

      FACTOR=TABLEI(2,IFIRST)                                           04230000   

      CALL FIND(NAME,SPOSN)                                             04240000   

C     TEMPORARILY STORE POINTERS IN INTABLE                             04250000   

46    TPOINT(ILOC)=SPOSN                                                04260000   

CC    NOTE  SPOSN=0 IF NO I.C.                                          04270000   

      TFACT(ILOC)=FACTOR                                                04280000   

      GO TO 41                                                          04290000   

CDUM  CONTENTS OF STMNT 47 MIGHT BE REDUNDANT (SEE 41+  IF(...)GOTO47)  04300000   

47    IF(ILOC.LT.INTLOC)GO TO 41                                        04310000   

CDUM  WRITE(6,4799) (I,PTS(I),MODE(I),(INTABL(I,J),J=3,14),I=1,5)       04320000   

4799  FORMAT(10(' ',3I4,12E10.2/))                                      04330000   

C     NOW SET OUTPUTS OF INTEGRATORS TO NEARLY ZERO                     04340000   

      ILOC=ILOC-1                                                       04350000   

C     IF ILOC=0 THEN THERE ARE NO INTEGRATORS                           04360000   

      IF(ILOC.LE.0)GO TO 1                                              04370000   

      DO 50 I=1,ILOC                                                    04380000   

50    ST3(PTS(I))=1.0E-10                                               04390000   

C     IF OTHER MEMORY DEVICES EXIST SET THEM TO ZERO TOO                04400000   

C     NOW UPDATE ALL MODULES                                            04410000   

CDUM  INITUP=0                                                          04420000   

55    CALL UPDATE                                                       04430000   

CDUM  INITUP=INITUP+1                                                   04440000   

CDUM  PRINT,'INITUP = ',INITUP                                          04450000   

CDUM  WRITE(6,666)(I,MTMAX(I),MTMIN(I),ST1(I),ST2(I),ST3(I),ST4(I),     04460000   

CDUM 2 I=1,20) ,(I,PTS(I),MODE(I),(INTABL(I,J),J=3,14),I=1,5)           04470000   

666   FORMAT(20(' ',I3,2E12.4,I10,2E12.4,I10/),10(' ',3I4,12E10.2/))    04480000   

C     ADJUST INTEGRATOR OUTPUTS,WATCH FOR MAXIMUM ERROR                 04490000   

      ERRINT=0.0                                                        04500000   

      DO 60 I=1,ILOC                                                    04510000   

      POINT=TPOINT(I)                                                   04520000   

      IPOINT=PTS(I)                                                     04530000   

C     IF POINT=0 THEN I.C.=0.0 VOLTS                                    04540000   

      IF(POINT.EQ.0)GO TO 58                                            04550000   

      TEMP=ST3(POINT)*TFACT(I)                                          04560000   

      ERINT=ABS((TEMP+ST3(IPOINT))/TEMP)                                04570000   

      IF(ERINT.GT.ERRINT)ERRINT=ERINT                                   04580000   

      ST3(IPOINT)=-TEMP                                                 04590000   

      GO TO 60                                                          04600000   

58    ST3(IPOINT)=0.0                                                   04610000   

60    CONTINUE                                                          04620000   

C     IF ERROR IS SMALL ENOUGH WE ARE FINISHED                          04630000   

      IF(ERRINT.GT.RELERR)GO TO 55                                      04640000   

C     NOTE:THE LAST 'UPDATE' PROVIDED US WITH THE INTEGRATOR DERIVATIVES04650000   

C     (INPUTS)FOR TIME=0                                                04660000   

CDUM  TEMP OUTPUT                                                       04670000   

1     CONTINUE                                                          04680000   

      IP=0                                                              04690000   

      PRINT,'        MODULE     VALUE        END OF INITAL'             04700000   

111   IP=IP+1                                                           04710000   

      PTAB=PTABLE(1,IP)                                                 04720000   

      IF(PTAB.EQ.0)GO TO 112                                            04730000   

      CALL SSCAN(IP,IS)                                                 04740000   

      PRINT,PTAB,ST3(IS)                                                04750000   

      GO TO 111                                                         04760000   

112   RETURN                                                            04770000   

CDUM  END OF TEMP RESTORE   1     RETURN                                04780000   

70    CALL SSCAN(PSPOT,SPOSN)                                           04790000   

      ST3P=((PREF-PTAB)*2/NMBIAS+1)                                     04800000   

      ST2(SPOSN)=ST3P                                                   04810000   

      ST3(SPOSN)=ST3P                                                   04820000   

      GO TO 30                                                          04830000   

      END                                                               04840000   

$ENTRY                                                                  04850000   

**********     INITT         *******************************************04860000   

//LABELS JOB  'P0292J.A.FIEL',CLASS=T                                   04870000   

/*ROUTE  PRINT ENG                                                      04880000   

//    EXEC     PGM=IEHINITT                                             04890000   

//SYSPRINT DD SYSOUT=A                                                  04900000   

//LABEL DD DCB=(DEN=2),UNIT=(2400,1,DEFER)                              04910000   

//SYSIN DD *                                                            04920000   

LABEL  INITT   SER=HOLDEN                                               04930000   

/*                                                                      04940000   

**********     MSCAN         *******************************************04950000   

C& MSCAN *                 ******************************************** 04960000   

      SUBROUTINE MSCAN(MODULE,MAX)                                      04970000   

C     SCANS MAXIMUM TABLE FOR MODULE , RETURNS MAX                      04980000   

      INTEGER*4 MTABLE(2,50)                                            04990000   

      REAL*4 TABLEM(2,50)                                               05000000   

      EQUIVALENCE(MTABLE(1,1),TABLEM(1,1))                              05010000   

      COMMON/MSCANC/MTABLE                                              05020000   

      REAL*4 MAX                                                        05030000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    05040000   

     2,ICODE,NMBIAS                                                     05050000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       05060000   

     2,RFVOLT,ICODE,NMBIAS                                              05070000   

      I=1                                                               05080000   

10    MTAB1=MTABLE(1,I)                                                 05090000   

      IF(MTAB1.EQ.0)GOTO30                                              05100000   

      IF(MTAB1.EQ.MODULE)GOTO20                                         05110000   

      IF(I.EQ.MSIZE)GOTO30                                              05120000   

      I=I+1                                                             05130000   

      GOTO10                                                            05140000   

20    MAX=TABLEM(2,I)                                                   05150000   

      RETURN                                                            05160000   

30    MAX=0.                                                            05170000   

      RETURN                                                            05180000   

      END                                                               05190000   

$ENTRY                                                                  05200000   

**********     N.DIAGRM      *******************************************05210000   

C& DIAGRAM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05220000   

$PRINTON                                                                05230000   

C     DIAGRAM RECEIVES INPUT IN AN ANALOG BLOCK DIAGRAM FORM            05240000   

C              IN PSEUDO-ENGLISH OR SHORT CODE FORM.                    05250000   

      SUBROUTINE DIAGRM                                                 05260000   

      INTEGER*4 START,TEMP,WFIX/25167/,WEXACT/90181844/,W2,K,IADD,ICSAV105270000   

     2,PREF/18000/,NREF/19000/,STEND/39/,EQUAL/40/,                     05280000   

     4CLOSE/41/,PLUS/49/,MINUS/50/,STAR/51/,SLASH/52/,COMMA/54/,OPEN/55/05290000   

     5,WIN/590/,WOUT/62804/,WMAX/53336/,WIC/579/                        05300000   

                                                                        05310000   

      REAL*4 ICSAV2                                                     05320000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    05330000   

     2,ICODE,NMBIAS                                                     05340000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       05350000   

     2,RFVOLT,ICODE,NMBIAS                                              05360000   

      LOGICAL SIGN,CONCAT,INITCO,OENTER                                 05370000   

      INTEGER*4 PTABLE(4,50),PNEXT,ITABLE(2,150),IPOSN,OTABLE(6,50)     05380000   

     2,OPOINT                                                           05390000   

      REAL*4 TABLEI(2,150),TABLEO(6,50)                                 05400000   

      EQUIVALENCE(ITABLE(1,1),TABLEI(1,1)),(OTABLE(1,1),TABLEO(1,1))    05410000   

      COMMON /TABLES/PTABLE,PNEXT,ITABLE,IPOSN,OTABLE,OPOINT            05420000   

      INTEGER*2 SCOUNT                                                  05430000   

      COMMON/DIAGMC/SCOUNT                                              05440000   

      INTEGER*4 CODEW,WORD(2),CHINXT                                    05450000   

      REAL*4 NUMBER                                                     05460000   

      EQUIVALENCE(WORD(2),NUMBER)                                       05470000   

      COMMON/CSEARC/CODEW,WORD,CHINXT                                   05480000   

      INTEGER*2 ITITLE(80)                                              05490000   

      COMMON/CTITLE/ITITLE                                              05500000   

      INTEGER*2 USE(25),MM                                              05510000   

      COMMON /CMARK/MM,USE                                              05520000   

      EQUIVALENCE (W2,TEMP,K)                                           05530000   

      INTEGER*4 STABLE(50,4),ST1(50),ST4(50),IST2(50),PTS(10),MODE(10), 05540000   

     2 IFIRST,ILAST,SLOC,MINT,STEP                                      05550000   

      REAL*4 MTABLE(50,2),MTMAX(50),MTMIN(50),INTABL(10,14)             05560000   

     2,ST2(50),ST3(50),YP1(10),Y0(10),YM1(10),YM2(10)                   05570000   

     3,DYP1(10),DY0(10),DYM1(10),DYM2(10),DYM3(10),DYM4(10),DYM5(10),   05580000   

     4DYM6(10)                                                          05590000   

     5,FTIME,DTIME,DTMIN,RELERR,OUTSTP                                  05600000   

      LOGICAL CORECT                                                    05610000   

      EQUIVALENCE(INTABL(1,1),PTS(1)),(MTABLE(1,1),MTMAX(1)),           05620000   

     2(STABLE(1,1),ST1(1)),(IST2(1),ST2(1))                             05630000   

      COMMON/SIMULC/MTMAX,MTMIN,ST1,ST2,ST3,ST4,PTS,MODE,YP1,Y0,YM1,YM2,05640000   

     2DYP1,DY0,DYM1,DYM2,DYM3,DYM4,DYM5,DYM6                            05650000   

     3,IFIRST,ILAST,SLOC,FTIME,DTIME,DTMIN,RELERR,OUTSTP,MINT,CORECT,   05660000   

     4 STEP,NINT,TIME                                                   05670000   

C     DIAGRAM MAINLINE                                                  05680000   

CCCCC START HERE TO GET NEW LINE AFTER ERROR                            05690000   

2     CALL NLINE1(START)                                                05700000   

      IF(START.EQ. 4)GO TO 220                                          05710000   

      CALL NLINE2                                                       05720000   

C                                                        ERROR 101      05730000   

      IF(START.NE.7)CALL ERROR(101,&2)                                  05740000   

CCC   GO GET DIAGRAM                                                    05750000   

      CALL SEARCH(START)                                                05760000   

C                                                        ERROR 102      05770000   

10    IF(CHINXT.NE.SLASH.OR.CODEW.NE.1)CALL ERROR(102,&1)               05780000   

      CALL SPLIT(WORD)                                                  05790000   

      CALL ASSIGN(WORD)                                                 05800000   

CCCCC MUST ENTER NAME AND NUMBER IN PTABLE AND ZERO THE FOLLOWING LINE  05810000   

      CALL MARK(WORD(1))                                                05820000   

      PTABLE(1,PNEXT)=WORD(1)                                           05830000   

      PP=PNEXT+1                                                        05840000   

      DO 14 I=1,4                                                       05850000   

14    PTABLE(I,PP)=0                                                    05860000   

      OENTER=.FALSE.                                                    05870000   

      INITCO=.FALSE.                                                    05880000   

      IADD=0                                                            05890000   

CCCCC IF THERE ARE TWO SLASHES IN THE LINE THEY ENCLOSE THE PARAMETERS  05900000   

      IF(SCOUNT-2)30,20,17                                              05910000   

C                                                        ERROR 103      05920000   

17    CALL ERROR( 103,&1)                                               05930000   

CCCCC THIS SECTION DECODES THE PARAMETERS                               05940000   

20    TEMP=0                                                            05950000   

25    CALL SEARCH(0)                                                    05960000   

C                                                        ERROR 104      05970000   

      IF(CODEW.NE.1)CALL ERROR(104,&1)                                  05980000   

      IF(WORD(2).EQ.WFIX)TEMP=TEMP+FIX                                  05990000   

      IF(WORD(2).EQ.WEXACT)TVMP=TEMP+EXACT                              06000000   

      IF(CHINXT.EQ.COMMA)GO TO 25                                       06010000   

      PTABLE(4,PNEXT)=TEMP                                              06020000   

      IF(CHINXT.NE.SLASH)GOTO17                                         06030000   

CCCCC WE NOW HAVE ALL THE PARAMETERS PROCEED TO COLLECT THE ARGUMENTS   06040000   

30    CALL SEARCH(0)                                                    06050000   

      IF(CHINXT.NE.EQUAL)GO TO 17                                       06060000   

35    W2=WORD(2)                                                        06070000   

      IF(W2.EQ. WIN)GOTO  50                                            06080000   

      IF(W2.EQ.WOUT)GOTO 100                                            06090000   

      IF(W2.EQ.WMAX)GOTO 150                                            06100000   

      IF(W2.EQ. WIC)GOTO 160                                            06110000   

C                                                        ERROR 105      06120000   

      CALL ERROR( 105,&1)                                               06130000   

CCCCC THIS IS THE 'IN' SECTION                                          06140000   

50    CONTINUE                                                          06150000   

54    IADD=IADD+1                                                       06160000   

      CONCAT=.FALSE.                                                    06170000   

      K=IADD+IPOSN                                                      06180000   

55    CALL SEARCH (0)                                                   06190000   

      TABLEI(2,K)=1.                                                    06200000   

      IF(CHINXT.EQ.STAR)GOTO60                                          06210000   

      IF(CHINXT.EQ.COMMA.OR.CHINXT.EQ.STEND)GOTO70                      06220000   

      IF(CHINXT.EQ.EQUAL)GOTO95                                         06230000   

C                                                        ERROR 106      06240000   

      CALL ERROR( 106,&1)                                               06250000   

C                                                        ERROR 107      06260000   

60    IF(CONCAT)CALL ERROR(107,&1)                                      06270000   

      CONCAT=.TRUE.                                                     06280000   

70    IF(CODEW-1)77,80,90                                               06290000   

C                                                        ERROR 108      06300000   

77    CALL ERROR( 108,&1)                                               06310000   

80    CALL SPLIT(WORD)                                                  06320000   

      CALL ASSIGN(WORD)                                                 06330000   

      ITABLE(1,K)=WORD(1)                                               06340000   

85    IF(CHINXT.EQ.STAR)GOTO55                                          06350000   

      IF(CHINXT.EQ.COMMA)GOTO54                                         06360000   

CCCCC WE HAVE THE LAST 'IN'PUT MAKE FIRST ENTRY IN ITABLE               06370000   

95    IF(INITCO)GOTO98                                                  06380000   

96    IF(CHINXT.EQ.STEND)IADD=IADD+1                                    06390000   

      ITABLE(1,IPOSN)=ICODE+IADD                                        06400000   

      ITABLE(2,IPOSN)=PNEXT                                             06410000   

      PTABLE(2,PNEXT)=IPOSN                                             06420000   

      IPOSN=IPOSN+IADD                                                  06430000   

      ITABLE(1,IPOSN)=0                                                 06440000   

      IF(CHINXT.EQ.STEND)GOTO40                                         06450000   

C     CHINXT=EQUAL                                                      06460000   

      GOTO 35                                                           06470000   

98    K=K+1                                                             06480000   

      ITABLE(1,K)=ICSAV1                                                06490000   

      TABLEI(2,K)=ICSAV2                                                06500000   

      IADD=IADD+1                                                       06510000   

      GO TO 96                                                          06520000   

CCCCC EXPECT A COEFFICIENT                                              06530000   

C                                                        ERROR 109      06540000   

90    IF(.NOT.CONCAT)CALL ERROR(0109,&1)                                06550000   

      TABLEI(2,K)=NUMBER                                                06560000   

      GO TO 85                                                          06570000   

CCCCC THIS IS THE 'OUT' INPUT COLLECTOR                                 06580000   

100   SIGN=.FALSE.                                                      06590000   

      PTABLE(3,PNEXT)=OPOINT                                            06600000   

      OTABLE(1,OPOINT)=PNEXT                                            06610000   

C     ZERO NEXT ENTRY IN OTABLE                                         06620000   

      K=OPOINT+1                                                        06630000   

      OTABLE(1,K)=0                                                     06640000   

      DO 101 J=5,6                                                      06650000   

      OTABLE(J-2,K)=0                                                   06660000   

101   TABLEO(J,K)=0.                                                    06670000   

      OENTER=.TRUE.                                                     06680000   

      TABLEO(2,OPOINT)=1.                                               06690000   

102   CALL SEARCH(0)                                                    06700000   

      IF(IABS(CODEW)-1)130,109,110                                      06710000   

C                                                        ERROR 110      06720000   

109   IF((OTABLE(3,OPOINT)+OTABLE(4,OPOINT)).NE.0)CALL ERROR(110,&1)    06730000   

      IF(CODEW.EQ.-1)WORD(1)=-WORD(1)                                   06740000   

      OTABLE(3,OPOINT)=WORD(1)                                          06750000   

      OTABLE(4,OPOINT)=WORD(2)                                          06760000   

      GOTO 120                                                          06770000   

110   TABLEO(2,OPOINT)=NUMBER                                           06780000   

120   IF(CHINXT.EQ.OPEN)GOTO 135                                        06790000   

      IF(CHINXT.EQ.STAR)GOTO102                                         06800000   

C                                                        ERROR 112      06810000   

      IF(CHINXT.NE.COMMA.AND.CHINXT.NE.STEND)CALL ERROR(112,&1)         06820000   

125   IF(SIGN)TABLEO(2,OPOINT)=-TABLEO(2,OPOINT)                        06830000   

      IF(CHINXT.EQ.STEND)GOTO40                                         06840000   

      GOTO30                                                            06850000   

130   IF(CHINXT.EQ.COMMA.OR.CHINXT.EQ.STEND)GOTO125                     06860000   

      IF(CHINXT.EQ.OPEN)GOTO135                                         06870000   

      IF(CHINXT.EQ.PLUS)GOTO102                                         06880000   

C                                                        ERROR 113      06890000   

      IF(CHINXT.NE.MINUS)CALL ERROR(113,&1)                             06900000   

      SIGN=.TRUE.                                                       06910000   

      GOTO102                                                           06920000   

135   CALL SEARCH(0)                                                    06930000   

C                                                        ERROR 114      06940000   

      IF(CHINXT.NE.CLOSE.OR.CODEW.LE.1.OR.TABLEO(5,OPOINT).NE.0)        06950000   

     2CALL ERROR(114 ,&1)                                               06960000   

      TABLEO(5,OPOINT)=NUMBER                                           06970000   

      GOTO102                                                           06980000   

CCCCC HERE LIES THE 'MAX' INPUT COLLECTOR SECTION                       06990000   

150   CALL SEARCH(0)                                                    07000000   

C                                                        ERROR 115      07010000   

      IF(CODEW.LT.2.OR.CHINXT.NE.STEND.AND.CHINXT.NE.COMMA.OR.          07020000   

     1 TABLEO(6,OPOINT).NE.0)CALL ERROR(115,&1)                         07030000   

      TABLEO(6,OPOINT)=NUMBER                                           07040000   

      IF(OENTER)GOTO155                                                 07050000   

      OTABLE(3,OPOINT)=0                                                07060000   

      OTABLE(4,OPOINT)=0                                                07070000   

      OENTER=.TRUE.                                                     07080000   

155   IF(CHINXT.EQ.COMMA)GO TO 30                                       07090000   

      GOTO40                                                            07100000   

CCCCC THE 'IC' INPUT SECTION RUNS LIKE THIS.                            07110000   

160   INITCO=.TRUE.                                                     07120000   

      ICSAV1=0                                                          07130000   

      ICSAV2=1.                                                         07140000   

161   CALL SEARCH(0)                                                    07150000   

      IF(CODEW-1)190,170,175                                            07160000   

170   CALL SPLIT(WORD)                                                  07170000   

      CALL ASSIGN(WORD)                                                 07180000   

      ICSAV1=-WORD(1)                                                   07190000   

      GO TO 178                                                         07200000   

175   ICSAV2=NUMBER*ICSAV2                                              07210000   

178   IF(CHINXT.EQ.STAR)GO TO 161                                       07220000   

C                                                        ERROR 116      07230000   

      IF(CHINXT.NE.COMMA.AND.CHINXT.NE.STEND)CALL ERROR(116,&1)         07240000   

      IF(ICSAV1.EQ.0)GO TO 195                                          07250000   

180   IF(SIGN)ICSAV2=-ICSAV2                                            07260000   

      IF(IADD.EQ.0)GO TO 185                                            07270000   

      OLIPSN=IPOSN-IADD                                                 07280000   

      ITABLE(1,OLIPSN)=ITABLE(1,OLIPSN)+1                               07290000   

      ITABLE(1,IPOSN)=ICSAV1                                            07300000   

      TABLEI(2,IPOSN)=ICSAV2                                            07310000   

      IPOSN=IPOSN+1                                                     07320000   

      ITABLE(1,IPOSN)=0                                                 07330000   

185   IF(CHINXT.EQ.COMMA)GO TO 30                                       07340000   

CCCCC THEN CHINXT=STEND                                                 07350000   

      GO TO 40                                                          07360000   

190   IF(CHINXT.EQ.PLUS)GO TO 161                                       07370000   

C                                                        ERROR 117      07380000   

      IF(CHINXT.NE.MINUS)CALL ERROR(117,&1)                             07390000   

      SIGN=.TRUE.                                                       07400000   

      GO TO 161                                                         07410000   

195   ICSAV1=PREF                                                       07420000   

C     PREF=P.REF=18000;NREF=N.REF=19000                                 07430000   

      IF(.NOT.SIGN)GO TO 180                                            07440000   

      ICSAV1=NREF                                                       07450000   

      SIGN=.FALSE.                                                      07460000   

      GO TO 180                                                         07470000   

1     CONTINUE                                                          07480000   

40    PNEXT=PNEXT+1                                                     07490000   

      IF(OENTER)OPOINT=OPOINT+1                                         07500000   

      GO TO 2                                                           07510000   

CCC   GET DIAGRAM IN JIFFY FORMAT                                       07520000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 07530000   

C     DIAEG1 ENTRY POINT                                                07540000   

      ENTRY DIAGE1                                                      07550000   

      CALL SEARCH(0)                                                    07560000   

      IF(WORD(2).NE.WJIFFY.OR. CHINXT.NE.RSLASH)GO TO 10                07570000   

200   READ(5,210) ITITLE                                                07580000   

210   FORMAT(80A1)                                                      07590000   

      READ (5,201) PNEXT                                                07600000   

      READ (5,202) ((PTABLE(J,K),J=1,4),K=1,PNEXT)                      07610000   

201   FORMAT(' ',I5)                                                    07620000   

202   FORMAT(' ', 6X  ,4I12)                                            07630000   

      READ (5,203) IPOSN                                                07640000   

      READ (5,204)((ITABLE(I,J),I=1,2),J=1,IPOSN)                       07650000   

203   FORMAT(' ',I5)                                                    07660000   

204   FORMAT(' ',  6X ,2I12)                                            07670000   

      READ (5,205)OPOINT                                                07680000   

      READ (5,206) ((OTABLE(I,J),I=1,6),J=1,OPOINT)                     07690000   

205   FORMAT(' ',I5)                                                    07700000   

206   FORMAT(' ',  6X ,6I12)                                            07710000   

      READ(5,210)                                                       07720000   

      READ(5,207)(USE(I),I=1,MM)                                        07730000   

207   FORMAT(' ',5I10)                                                  07740000   

CWAIT READ (5,208) K                                                    07750000   

208   FORMAT(' ',I5)                                                    07760000   

CWAIT READ (5,209)((MTABLE(J,I),I=1,2),J=1,K)                           07770000   

209   FORMAT(9X,2E20.8)                                                 07780000   

      GO TO 2                                                           07790000   

CCC   DIAGRAM FINAL CHECK                                               07800000   

C      READY TO RETURN    CHECK THAT ALL INPUTS SPECIFIED ARE IN PTABLE 07810000   

C     IT IS NECESSARY TO ADD N.REF AND P.REF TO PTABLE  BEFORE          07820000   

C                          CHECKING THE INPUTS.                         07830000   

220   CONTINUE                                                          07840000   

230   NAME=PREF                                                         07850000   

232   PTABLE(1,PNEXT)=NAME                                              07860000   

      DO 233 I=2,4                                                      07870000   

233   PTABLE(I,PNEXT)=0                                                 07880000   

      CALL PSCAN(NAME,IT)                                               07890000   

      IF(IT.LT.PNEXT)PNEXT=PNEXT-1                                      07900000   

      IF(NAME.EQ.NREF)GO TO 235                                         07910000   

      NAME=NREF                                                         07920000   

      PNEXT=PNEXT+1                                                     07930000   

      IF(PNEXT.GE.PSIZE)CALL ERROR1(118,&241)                           07940000   

      GO TO 232                                                         07950000   

235   PNEXT=PNEXT+1                                                     07960000   

      PTABLE(1,PNEXT)=0                                                 07970000   

      DO 225 I=1,ISIZE                                                  07980000   

      MODULE=IABS(ITABLE(1,I))                                          07990000   

      IF(MODULE.EQ.0)GO TO 240                                          08000000   

      IF(MODULE.GE.ICODE)GO TO 225                                      08010000   

      CALL PSCAN(MODULE,IT)                                             08020000   

C      PSCAN WILL ISSUE NECESSARY ERRORS                                08030000   

225   CONTINUE                                                          08040000   

240   CALL NLINE2                                                       08050000   

241   RETURN                                                            08060000   

      END                                                               08070000   

$PRINTOFF                                                               08080000   

$ENTRY                                                                  08090000   

**********     NORMAL        *******************************************08100000   

C& NORMAL *        **************************************************** 08110000   

      SUBROUTINE NORMAL(NSF)                                            08120000   

C     SELECT NORMALIZED SCALE FACTORS FROM TABLEN                       08130000   

CCCC  ENTER WITH NSF=EXAXT NORMALIZED SCALE FACTOR                      08140000   

      INTEGER*4 POWER,CODE ,NBASE/10/                                   08150000   

      REAL*4 LASTN,NSF,MAX,BASEN/10.0/                                  08160000   

      INTEGER*4 NCODE,BCODE                                             08170000   

      REAL*4 TABLEN(10),TABLEB(10)                                      08180000   

      COMMON/SCALEC/TABLEN,TABLEB,NCODE,BCODE                           08190000   

5     IF(NCODE.GT.0)GOTO20                                              08200000   

C    NCODE SPECIFIES THE NUMBER OF ENTRIES IN TABLEN                    08210000   

C     NCODE      SELECT FROM SINGLE LIST      -#                        08220000   

C                SELECT FROM POWERS OF LIST   +#                        08230000   

C     LIST IS IN ASCENDING ORDER                                        08240000   

20    POWER=0                                                           08250000   

      CODE=IABS(NCODE)                                                  08260000   

      TEMP1=TABLEN(1)                                                   08270000   

      IF(NSF.LT.TEMP1)GOTO21                                            08280000   

26    FACTOR=NBASE**POWER                                               08290000   

      DO 27 I=1,CODE                                                    08300000   

      TEMP=TEMP1                                                        08310000   

      TEMP1=TABLEN(I)*FACTOR                                            08320000   

      IF(NSF.LT.TEMP1)GO TO 25                                          08330000   

27    CONTINUE                                                          08340000   

      IF(NCODE.LT.0) GO TO 24                                           08350000   

      POWER=POWER+1                                                     08360000   

      GO TO 26                                                          08370000   

21    IF(NCODE.LT.0)RETURN                                              08380000   

22    POWER=POWER-1                                                     08390000   

      FACTOR=BASEN**POWER                                               08400000   

      DO 23 I=1,CODE                                                    08410000   

      TEMP=TABLEN(CODE+1-I)*FACTOR                                      08420000   

      IF(NSF.GT.TEMP)GO TO 25                                           08430000   

23    CONTINUE                                                          08440000   

      GO TO 22                                                          08450000   

24    TEMP=TEMP1                                                        08460000   

25    NSF=TEMP                                                          08470000   

      RETURN                                                            08480000   

      END                                                               08490000   

$ENTRY                                                                  08500000   

**********     NW.DUPLC      *******************************************08510000   

C                                             MSGLEVEL=1                08520000   

C                  DSN=JOBLIB,DISP=SHR                                  08530000   

C                                                                       08540000   

C                                                                       08550000   

$JOB   DUPLC     T0173FIELD.HO,KP=29,P=99,C=9999,RUN=F,T=(,10),LIBLIST  08560000   

C&  DUPLICATOR PROGRAMME  * * * * * * * * * * * * * * * * * * * * * * * 08570000   

C     THIS PROGRAMME DUPLICATES CARD DECKS AND ADDS SEQUENCE NUMBERS    08580000   

C     THE SEQUENCE NUMBERS ARE OF THE FORM 'ABCDNNNN' WHERE ABCD IS A   08590000   

C      FOUR CHARACTER NAME AND NNNN IS A FOUR DIGIT NUMBER (WITH ALL    08600000   

C      ZEROS INCLUDED) WHICH IS INCREMENTED BY TEN FOR EACH CARD        08610000   

C     THE NAME MAY BE SPECIFIED BY INCLUDING IN THE DATA THE            08620000   

C      FOLLOWING CARD                                                   08630000   

C              COLUMN     1  4    9                                     08640000   

C                         '  '    '                                     08650000   

C                         C& NAME-COMMENTS                              08660000   

C     INCLUDE THE 'C'S IN COLUMN 1 THE NAME STARTS IN COLUMN 4          08670000   

C     THE NAME SPECIFYING CARDS ARE INCLUDED IN THE SEQUENCED OUTPUT    08680000   

C     THE NAME MAY BE SPECIFIED ANY NUMBER OF TIMES BUT THERE MUST      08690000   

C      NOT BE MORE THAN 999 CARDS BETWEEN NAME IDENTIFIERS              08700000   

C     WHEN DUPLICATED THE BLANKS FOLLOWING THE FIRST THREE              08710000   

C      BLANKS WILL BE CONVERTED TO "*" .                                08720000   

C     NOTE: THE PROGRAMME STOPS WHEN IT ENCOUNTERS THE                  08730000   

C      FOLLOWING CARD :                                                 08740000   

C              COLUMN     1                                             08750000   

C                         '                                             08760000   

C                         C.                                            08770000   

C     WARNING: IF THE SAME NAME IS SPECIFIED MORE THAN ONCE IT          08780000   

C               WILL RESULT IN NON-SORTABLE CARDS .                     08790000   

C              THE FIRST FOUR CHARACTERS OF THE NAME SHOULD BE          08800000   

C               NON-BLANK .                                             08810000   

      INTEGER*2 ALPHA(80),NUMB(4),CARRY,H/256/,BLANK/'  '/,STAR/'* '/   08820000   

      INTEGER*4 IUNIT/5/,OUNIT/6/,NAME/' ABC'/,TEST/'C & '/,SIGN        08830000   

     2,END/'C . '/                                                      08840000   

      EQUIVALENCE(SIGN,ALPHA(1))                                        08850000   

      OUNIT=7                                                           08860000   

2     CONTINUE                                                          08870000   

      DO 1 I=1,4                                                        08880000   

1     NUMB(I)=0                                                         08890000   

      IC=0                                                              08900000   

3     CONTINUE                                                          08910000   

      READ(IUNIT,21) (ALPHA(I),I=1,80)                                  08920000   

      IF(TEST.EQ.SIGN)GO TO 50                                          08930000   

      IF(SIGN.EQ.END) GO TO 70                                          08940000   

      CARRY=1                                                           08950000   

      IC=IC+1                                                           08960000   

      DO 10 I=1,3                                                       08970000   

      K=4-I                                                             08980000   

      N=NUMB(K)+CARRY                                                   08990000   

      CARRY=N/10                                                        09000000   

      NUMB(K)=N-CARRY*10                                                09010000   

10    CONTINUE                                                          09020000   

      IF(CARRY.EQ.1)GO TO 25                                            09030000   

      WRITE(OUNIT,31) (ALPHA(I),I=1,72),NAME,(NUMB(I),I=1,4)            09040000   

      GO TO 3                                                           09050000   

25    WRITE(6,26)                                                       09060000   

      GO TO 70                                                          09070000   

50    CONTINUE                                                          09080000   

      WRITE(6,51) NAME,IC                                               09090000   

      NAME=(ALPHA(4)*H+ALPHA(5))*H+ALPHA(6)+ALPHA(7)/H                  09100000   

      PRINT,'A4*H:A4:A4/H ',ALPHA(4)*H,ALPHA(4),ALPHA(4)/H              09110000   

      PRINT,'A5*H:A5:H ',ALPHA(5)*H,ALPHA(5),H                          09120000   

      PRINT,'A6:A7:A7/H ',ALPHA(6),ALPHA(7),ALPHA(7)/H                  09130000   

      DO 58 I=12,72                                                     09140000   

      K=I                                                               09150000   

      DO 54 J=1,4                                                       09160000   

54    IF(ALPHA(I+J).NE.BLANK)GO TO 58                                   09170000   

      GO TO 60                                                          09180000   

58    CONTINUE                                                          09190000   

60    K=K+2                                                             09200000   

      DO 61 I=K,72                                                      09210000   

61    ALPHA(I)=STAR                                                     09220000   

      WRITE(OUNIT,62)NAME,(ALPHA(I),I=8,72),NAME                        09230000   

      GO TO 2                                                           09240000   

70    WRITE(6,51) NAME,IC                                               09250000   

      STOP                                                              09260000   

21    FORMAT(80A1)                                                      09270000   

26    FORMAT(' ***ERROR . . . MORE THAN 999CARDS***')                   09280000   

31    FORMAT(    72A1,A4,4I1)                                           09290000   

51    FORMAT(3X,A4,I6)                                                  09300000   

62    FORMAT('C& ',A4,65A1,A4,'0000')')                                 09310000   

      END                                                               09320000   

$STOP                                                                   09330000   

/*                                                                      09340000   

**********     O.DIAGRM      *******************************************09350000   

C& DIAGRAM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09360000   

C     DIAGRAM RECEIVES INPUT IN AN ANALOG BLOCK DIAGRAM FORM            09370000   

C              IN PSEUDO-ENGLISH OR SHORT CODE FORM.                    09380000   

      SUBROUTINE DIAGRM                                                 09390000   

      INTEGER*4 START,TEMP,WFIX/25167/,WEXACT/90181844/,W2,K,IADD,ICSAV109400000   

     2,PREF/18000/,NREF/19000/,STEND/39/,EQUAL/40/,                     09410000   

     4CLOSE/41/,PLUS/49/,MINUS/50/,STAR/51/,SLASH/52/,COMMA/54/,OPEN/55/09420000   

     5,WIN/590/,WOUT/62804/,WMAX/53336/,WIC/579/                        09430000   

      INTEGER*4 WJIFFY/170156441/,RSLASH/52/                            09440000   

      REAL*4 ICSAV2                                                     09450000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    09460000   

     2,ICODE,NMBIAS                                                     09470000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       09480000   

     2,RFVOLT,ICODE,NMBIAS                                              09490000   

      LOGICAL SIGN,CONCAT,INITCO,OENTER                                 09500000   

      INTEGER*4 PTABLE(4,50),PNEXT,ITABLE(2,150),IPOSN,OTABLE(6,50)     09510000   

     2,OPOINT                                                           09520000   

      REAL*4 TABLEI(2,150),TABLEO(6,50)                                 09530000   

      EQUIVALENCE(ITABLE(1,1),TABLEI(1,1)),(OTABLE(1,1),TABLEO(1,1))    09540000   

      COMMON /TABLES/PTABLE,PNEXT,ITABLE,IPOSN,OTABLE,OPOINT            09550000   

      INTEGER*2 SCOUNT                                                  09560000   

      COMMON/DIAGMC/SCOUNT                                              09570000   

      INTEGER*4 CODEW,WORD(2),CHINXT                                    09580000   

      REAL*4 NUMBER                                                     09590000   

      EQUIVALENCE(WORD(2),NUMBER)                                       09600000   

      COMMON/CSEARC/CODEW,WORD,CHINXT                                   09610000   

      INTEGER*2 ITITLE(80)                                              09620000   

      COMMON/CTITLE/ITITLE                                              09630000   

      INTEGER*2 USE(25),MM                                              09640000   

      COMMON /CMARK/MM,USE                                              09650000   

      EQUIVALENCE (W2,TEMP,K)                                           09660000   

C     DIAGRAM MAINLINE                                                  09670000   

CCCCC START HERE TO GET NEW LINE AFTER ERROR                            09680000   

2     CALL NLINE1(START)                                                09690000   

      IF(START.EQ. 4)GO TO 220                                          09700000   

      CALL NLINE2                                                       09710000   

C                                                        ERROR 101      09720000   

      IF(START.NE.7)CALL ERROR(101,&2)                                  09730000   

CCC   GO GET DIAGRAM                                                    09740000   

      CALL SEARCH(START)                                                09750000   

C                                                        ERROR 102      09760000   

10    IF(CHINXT.NE.SLASH.OR.CODEW.NE.1)CALL ERROR(102,&1)               09770000   

      CALL SPLIT(WORD)                                                  09780000   

      CALL ASSIGN(WORD)                                                 09790000   

CCCCC MUST ENTER NAME AND NUMBER IN PTABLE AND ZERO THE FOLLOWING LINE  09800000   

      CALL MARK(WORD(1))                                                09810000   

      PTABLE(1,PNEXT)=WORD(1)                                           09820000   

      PP=PNEXT+1                                                        09830000   

      DO 14 I=1,4                                                       09840000   

14    PTABLE(I,PP)=0                                                    09850000   

      OENTER=.FALSE.                                                    09860000   

      INITCO=.FALSE.                                                    09870000   

      IADD=0                                                            09880000   

CCCCC IF THERE ARE TWO SLASHES IN THE LINE THEY ENCLOSE THE PARAMETERS  09890000   

      IF(SCOUNT-2)30,20,17                                              09900000   

C                                                        ERROR 103      09910000   

17    CALL ERROR( 103,&1)                                               09920000   

CCCCC THIS SECTION DECODES THE PARAMETERS                               09930000   

20    TEMP=0                                                            09940000   

25    CALL SEARCH(0)                                                    09950000   

C                                                        ERROR 104      09960000   

      IF(CODEW.NE.1)CALL ERROR(104,&1)                                  09970000   

      IF(WORD(2).EQ.WFIX)TEMP=TEMP+FIX                                  09980000   

      IF(WORD(2).EQ.WEXACT)TVMP=TEMP+EXACT                              09990000   

      IF(CHINXT.EQ.COMMA)GO TO 25                                       10000000   

      PTABLE(4,PNEXT)=TEMP                                              10010000   

      IF(CHINXT.NE.SLASH)GOTO17                                         10020000   

CCCCC WE NOW HAVE ALL THE PARAMETERS PROCEED TO COLLECT THE ARGUMENTS   10030000   

30    CALL SEARCH(0)                                                    10040000   

      IF(CHINXT.NE.EQUAL)GO TO 17                                       10050000   

35    W2=WORD(2)                                                        10060000   

      IF(W2.EQ. WIN)GOTO  50                                            10070000   

      IF(W2.EQ.WOUT)GOTO 100                                            10080000   

      IF(W2.EQ.WMAX)GOTO 150                                            10090000   

      IF(W2.EQ. WIC)GOTO 160                                            10100000   

C                                                        ERROR 105      10110000   

      CALL ERROR( 105,&1)                                               10120000   

CCCCC THIS IS THE 'IN' SECTION                                          10130000   

50    CONTINUE                                                          10140000   

54    IADD=IADD+1                                                       10150000   

      CONCAT=.FALSE.                                                    10160000   

      K=IADD+IPOSN                                                      10170000   

55    CALL SEARCH (0)                                                   10180000   

      TABLEI(2,K)=1.                                                    10190000   

      IF(CHINXT.EQ.STAR)GOTO60                                          10200000   

      IF(CHINXT.EQ.COMMA.OR.CHINXT.EQ.STEND)GOTO70                      10210000   

      IF(CHINXT.EQ.EQUAL)GOTO95                                         10220000   

C                                                        ERROR 106      10230000   

      CALL ERROR( 106,&1)                                               10240000   

C                                                        ERROR 107      10250000   

60    IF(CONCAT)CALL ERROR(107,&1)                                      10260000   

      CONCAT=.TRUE.                                                     10270000   

70    IF(CODEW-1)77,80,90                                               10280000   

C                                                        ERROR 108      10290000   

77    CALL ERROR( 108,&1)                                               10300000   

80    CALL SPLIT(WORD)                                                  10310000   

      CALL ASSIGN(WORD)                                                 10320000   

      ITABLE(1,K)=WORD(1)                                               10330000   

85    IF(CHINXT.EQ.STAR)GOTO55                                          10340000   

      IF(CHINXT.EQ.COMMA)GOTO54                                         10350000   

CCCCC WE HAVE THE LAST 'IN'PUT MAKE FIRST ENTRY IN ITABLE               10360000   

95    IF(INITCO)GOTO98                                                  10370000   

96    IF(CHINXT.EQ.STEND)IADD=IADD+1                                    10380000   

      ITABLE(1,IPOSN)=ICODE+IADD                                        10390000   

      ITABLE(2,IPOSN)=PNEXT                                             10400000   

      PTABLE(2,PNEXT)=IPOSN                                             10410000   

      IPOSN=IPOSN+IADD                                                  10420000   

      ITABLE(1,IPOSN)=0                                                 10430000   

      IF(CHINXT.EQ.STEND)GOTO40                                         10440000   

C     CHINXT=EQUAL                                                      10450000   

      GOTO 35                                                           10460000   

98    K=K+1                                                             10470000   

      ITABLE(1,K)=ICSAV1                                                10480000   

      TABLEI(2,K)=ICSAV2                                                10490000   

      IADD=IADD+1                                                       10500000   

      GO TO 96                                                          10510000   

CCCCC EXPECT A COEFFICIENT                                              10520000   

C                                                        ERROR 109      10530000   

90    IF(.NOT.CONCAT)CALL ERROR(0109,&1)                                10540000   

      TABLEI(2,K)=NUMBER                                                10550000   

      GO TO 85                                                          10560000   

CCCCC THIS IS THE 'OUT' INPUT COLLECTOR                                 10570000   

100   SIGN=.FALSE.                                                      10580000   

      PTABLE(3,PNEXT)=OPOINT                                            10590000   

      OTABLE(1,OPOINT)=PNEXT                                            10600000   

C     ZERO NEXT ENTRY IN OTABLE                                         10610000   

      K=OPOINT+1                                                        10620000   

      OTABLE(1,K)=0                                                     10630000   

      DO 101 J=5,6                                                      10640000   

      OTABLE(J-2,K)=0                                                   10650000   

101   TABLEO(J,K)=0.                                                    10660000   

      OENTER=.TRUE.                                                     10670000   

      TABLEO(2,OPOINT)=1.                                               10680000   

102   CALL SEARCH(0)                                                    10690000   

      IF(IABS(CODEW)-1)130,109,110                                      10700000   

C                                                        ERROR 110      10710000   

109   IF((OTABLE(3,OPOINT)+OTABLE(4,OPOINT)).NE.0)CALL ERROR(110,&1)    10720000   

      IF(CODEW.EQ.-1)WORD(1)=-WORD(1)                                   10730000   

      OTABLE(3,OPOINT)=WORD(1)                                          10740000   

      OTABLE(4,OPOINT)=WORD(2)                                          10750000   

      GOTO 120                                                          10760000   

110   TABLEO(2,OPOINT)=NUMBER                                           10770000   

120   IF(CHINXT.EQ.OPEN)GOTO 135                                        10780000   

      IF(CHINXT.EQ.STAR)GOTO102                                         10790000   

C                                                        ERROR 112      10800000   

      IF(CHINXT.NE.COMMA.AND.CHINXT.NE.STEND)CALL ERROR(112,&1)         10810000   

125   IF(SIGN)TABLEO(2,OPOINT)=-TABLEO(2,OPOINT)                        10820000   

      IF(CHINXT.EQ.STEND)GOTO40                                         10830000   

      GOTO30                                                            10840000   

130   IF(CHINXT.EQ.COMMA.OR.CHINXT.EQ.STEND)GOTO125                     10850000   

      IF(CHINXT.EQ.OPEN)GOTO135                                         10860000   

      IF(CHINXT.EQ.PLUS)GOTO102                                         10870000   

C                                                        ERROR 113      10880000   

      IF(CHINXT.NE.MINUS)CALL ERROR(113,&1)                             10890000   

      SIGN=.TRUE.                                                       10900000   

      GOTO102                                                           10910000   

135   CALL SEARCH(0)                                                    10920000   

C                                                        ERROR 114      10930000   

      IF(CHINXT.NE.CLOSE.OR.CODEW.LE.1.OR.TABLEO(5,OPOINT).NE.0)        10940000   

     2CALL ERROR(114 ,&1)                                               10950000   

      TABLEO(5,OPOINT)=NUMBER                                           10960000   

      GOTO102                                                           10970000   

CCCCC HERE LIES THE 'MAX' INPUT COLLECTOR SECTION                       10980000   

150   CALL SEARCH(0)                                                    10990000   

C                                                        ERROR 115      11000000   

      IF(CODEW.LT.2.OR.CHINXT.NE.STEND.AND.CHINXT.NE.COMMA.OR.          11010000   

     1 TABLEO(6,OPOINT).NE.0)CALL ERROR(115,&1)                         11020000   

      TABLEO(6,OPOINT)=NUMBER                                           11030000   

      IF(OENTER)GOTO155                                                 11040000   

      OTABLE(3,OPOINT)=0                                                11050000   

      OTABLE(4,OPOINT)=0                                                11060000   

      OENTER=.TRUE.                                                     11070000   

155   IF(CHINXT.EQ.COMMA)GO TO 30                                       11080000   

      GOTO40                                                            11090000   

CCCCC THE 'IC' INPUT SECTION RUNS LIKE THIS.                            11100000   

160   INITCO=.TRUE.                                                     11110000   

      ICSAV1=0                                                          11120000   

      ICSAV2=1.                                                         11130000   

161   CALL SEARCH(0)                                                    11140000   

      IF(CODEW-1)190,170,175                                            11150000   

170   CALL SPLIT(WORD)                                                  11160000   

      CALL ASSIGN(WORD)                                                 11170000   

      ICSAV1=-WORD(1)                                                   11180000   

      GO TO 178                                                         11190000   

175   ICSAV2=NUMBER*ICSAV2                                              11200000   

178   IF(CHINXT.EQ.STAR)GO TO 161                                       11210000   

C                                                        ERROR 116      11220000   

      IF(CHINXT.NE.COMMA.AND.CHINXT.NE.STEND)CALL ERROR(116,&1)         11230000   

      IF(ICSAV1.EQ.0)GO TO 195                                          11240000   

180   IF(SIGN)ICSAV2=-ICSAV2                                            11250000   

      IF(IADD.EQ.0)GO TO 185                                            11260000   

      OLIPSN=IPOSN-IADD                                                 11270000   

      ITABLE(1,OLIPSN)=ITABLE(1,OLIPSN)+1                               11280000   

      ITABLE(1,IPOSN)=ICSAV1                                            11290000   

      TABLEI(2,IPOSN)=ICSAV2                                            11300000   

      IPOSN=IPOSN+1                                                     11310000   

      ITABLE(1,IPOSN)=0                                                 11320000   

185   IF(CHINXT.EQ.COMMA)GO TO 30                                       11330000   

CCCCC THEN CHINXT=STEND                                                 11340000   

      GO TO 40                                                          11350000   

190   IF(CHINXT.EQ.PLUS)GO TO 161                                       11360000   

C                                                        ERROR 117      11370000   

      IF(CHINXT.NE.MINUS)CALL ERROR(117,&1)                             11380000   

      SIGN=.TRUE.                                                       11390000   

      GO TO 161                                                         11400000   

195   ICSAV1=PREF                                                       11410000   

C     PREF=P.REF=18000;NREF=N.REF=19000                                 11420000   

      IF(.NOT.SIGN)GO TO 180                                            11430000   

      ICSAV1=NREF                                                       11440000   

      SIGN=.FALSE.                                                      11450000   

      GO TO 180                                                         11460000   

1     CONTINUE                                                          11470000   

40    PNEXT=PNEXT+1                                                     11480000   

      IF(OENTER)OPOINT=OPOINT+1                                         11490000   

      GO TO 2                                                           11500000   

CCC   GET DIAGRAM IN JIFFY FORMAT                                       11510000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 11520000   

C     DIAEG1 ENTRY POINT                                                11530000   

      ENTRY DIAGE1                                                      11540000   

      CALL SEARCH(0)                                                    11550000   

      IF(WORD(2).NE.WJIFFY.OR. CHINXT.NE.RSLASH)GO TO 10                11560000   

200   READ(5,210) ITITLE                                                11570000   

210   FORMAT(80A1)                                                      11580000   

      READ (5,201) PNEXT                                                11590000   

      READ (5,202) ((PTABLE(J,K),J=1,4),K=1,PNEXT)                      11600000   

201   FORMAT(' ',I5)                                                    11610000   

202   FORMAT(' ', 6X  ,4I12)                                            11620000   

      READ (5,203) IPOSN                                                11630000   

      READ (5,204)((ITABLE(I,J),I=1,2),J=1,IPOSN)                       11640000   

203   FORMAT(' ',I5)                                                    11650000   

204   FORMAT(' ',  6X ,2I12)                                            11660000   

      READ (5,205)OPOINT                                                11670000   

      READ (5,206) ((OTABLE(I,J),I=1,6),J=1,OPOINT)                     11680000   

205   FORMAT(' ',I5)                                                    11690000   

206   FORMAT(' ',  6X ,6I12)                                            11700000   

      READ(5,210)                                                       11710000   

      READ(5,207)(USE(I),I=1,MM)                                        11720000   

207   FORMAT(' ',5I10)                                                  11730000   

      GO TO 2                                                           11740000   

CCC   DIAGRAM FINAL CHECK                                               11750000   

C      READY TO RETURN    CHECK THAT ALL INPUTS SPECIFIED ARE IN PTABLE 11760000   

C     IT IS NECESSARY TO ADD N.REF AND P.REF TO PTABLE  BEFORE          11770000   

C                          CHECKING THE INPUTS.                         11780000   

220   CONTINUE                                                          11790000   

230   NAME=PREF                                                         11800000   

232   PTABLE(1,PNEXT)=NAME                                              11810000   

      DO 233 I=2,4                                                      11820000   

233   PTABLE(I,PNEXT)=0                                                 11830000   

      CALL PSCAN(NAME,IT)                                               11840000   

      IF(IT.LT.PNEXT)PNEXT=PNEXT-1                                      11850000   

      IF(NAME.EQ.NREF)GO TO 235                                         11860000   

      NAME=NREF                                                         11870000   

      PNEXT=PNEXT+1                                                     11880000   

      IF(PNEXT.GE.PSIZE)CALL ERROR1(118,&241)                           11890000   

      GO TO 232                                                         11900000   

235   PNEXT=PNEXT+1                                                     11910000   

      PTABLE(1,PNEXT)=0                                                 11920000   

      DO 225 I=1,ISIZE                                                  11930000   

      MODULE=IABS(ITABLE(1,I))                                          11940000   

      IF(MODULE.EQ.0)GO TO 240                                          11950000   

      IF(MODULE.GE.ICODE)GO TO 225                                      11960000   

      CALL PSCAN(MODULE,IT)                                             11970000   

C      PSCAN WILL ISSUE NECESSARY ERRORS                                11980000   

225   CONTINUE                                                          11990000   

240   CALL NLINE2                                                       12000000   

241   RETURN                                                            12010000   

      END                                                               12020000   

$ENTRY                                                                  12030000   

**********     PDSQNEXT      *******************************************12040000   

//HOLDSQSH JOB  'T0173FIELD.HO,TIME=(,10)',MSGLEVEL=1                   12050000   

//JOBLIB  DD  DSN=JOBLIB,DISP=SHR                                       12060000   

//  EXEC  PGM=PDSQUISH                                                  12070000   

//DISK1  DD  VOLUME=SER=ENG111,UNIT=2314,DISP=OLD                       12080000   

//SYSPRINT  DD  SYSOUT=A,DCB=(RECFM=FB,BLKSIZE=121)                     12090000   

//SYSIN  DD  *                                                          12100000   

 CONDENSE DSNAME=T0173.FIELD.SRC,VOL=2314=ENG111                        12110000   

 CONDENSE DSNAME=TO173.FIELD.TSRC,VOL=2314=ENG111                       12120000   

 REMOVE MEMBER=TATODK                                                   12130000   

 REMOVE MEMBER=N.DIAGRM                                                 12140000   

 REMOVE MEMBER=PDSQNEXT                                                 12150000   

 REMOVE MEMBER=FILENME                                                  12160000   

/*                                                                      12170000   

**********     REORGN        *******************************************12180000   

C& NORMAL * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12190000   

      SUBROUTINE REORGN                                                 12200000   

      INTEGER*4 PTABLE(4,50),PNEXT,ITABLE(2,150),IPOSN,OTABLE(6,50)     12210000   

     2,OPOINT                                                           12220000   

      REAL*4 TABLEI(2,150),TABLEO(6,50)                                 12230000   

      EQUIVALENCE(ITABLE(1,1),TABLEI(1,1)),(OTABLE(1,1),TABLEO(1,1))    12240000   

      COMMON/TABLES/PTABLE,PNEXT,ITABLE,IPOSN,OTABLE,OPOINT             12250000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    12260000   

     2,ICODE,NMBIAS                                                     12270000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       12280000   

     2,RFVOLT,ICODE,NMBIAS                                              12290000   

      INTEGER*4 CODEW,WORD(2),CHINXT                                    12300000   

      REAL*4 NUMBER                                                     12310000   

      EQUIVALENCE(WORD(2),NUMBER)                                       12320000   

      COMMON/CSEARC/CODEW,WORD,CHINXT                                   12330000   

      INTEGER*4 MODULE,NAME,PTEST,ITEST,ILAST,INPUT,MOD,PP,PTAB,POT/12/ 12340000   

      REAL*4 MGAIN,PGAIN                                                12350000   

      LOGICAL INSCAL                                                    12360000   

      INTEGER*4 WPOTI/272451913   /,WNSERT/239883412   /,W1,W2,START,   12370000   

     2COMMA/54/,STEND/39/,RSLASH/52/                                    12380000   

      EQUIVALENCE(W1,WORD(1)),(W2,WORD(2))                              12390000   

C     REORGANIZE DIRECTOR SECTION                                       12400000   

5     CALL NLINE(START)                                                 12410000   

      IF(START.EQ.4)RETURN                                              12420000   

      CALL SEARCH(START)                                                12430000   

10    IF(W1.EQ.WPOTI.AND.W2.EQ.WNSERT)GO TO 100                         12440000   

      CALL ERROR(223,&1)                                                12450000   

C     ENTER HERE IF THERE ARE REQUESTS ON COMMAND CARD                  12460000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 12470000   

      ENTRY REORG1                                                      12480000   

15    CALL SEARCH(0)                                                    12490000   

      GO TO 10                                                          12500000   

C     ALL SUBSECTIONS RETURN HERE                                       12510000   

30    IF(CHINXT.EQ.COMMA)GO TO 15                                       12520000   

      IF(CHINXT.EQ.STEND)GO TO 5                                        12530000   

      CALL ERROR(224,&1)                                                12540000   

C     ERROR ROUTINE RETURN HERE                                         12550000   

1     IF(CHINXT.NE.COMMA.AND.CHINXT.NE.STEND)CALL SEARCH(0)             12560000   

      GO TO 30                                                          12570000   

CCCC  THIS SECTION INSERTS POTENTIOMETERS                               12580000   

100   PNEXT=0                                                           12590000   

120   PNEXT=PNEXT+1                                                     12600000   

      IF(PTABLE(1,PNEXT).NE.0)GO TO 120                                 12610000   

      IPOSN=0                                                           12620000   

122   IPOSN=IPOSN+1                                                     12630000   

      IF(ITABLE(1,IPOSN).NE.0)GO TO 122                                 12640000   

      PTEST=0                                                           12650000   

130   PTEST=PTEST+1                                                     12660000   

      MODULE=PTABLE(1,PTEST)                                            12670000   

      IF(MODULE.EQ.0)GO TO 30                                           12680000   

      NAME=MODULE/NMBIAS                                                12690000   

      IF(.NOT.INSCAL(MODULE))GO TO 130                                  12700000   

      ITEST=PTABLE(2,PTEST)                                             12710000   

      ILAST=ITABLE(1,ITEST)-ICODE-1+ITEST                               12720000   

      ITEST=ITEST+1                                                     12730000   

      DO 160 II=ITEST,ILAST                                             12740000   

      MGAIN=TABLEI(2,II)                                                12750000   

      IF(MGAIN.EQ.1.0.OR.MGAIN.EQ.2.0.OR.MGAIN.EQ.10.0.OR.MGAIN.EQ.20.0 12760000   

     2)GO TO 160                                                        12770000   

      PGAIN=MGAIN                                                       12780000   

      MGAIN=1.0                                                         12790000   

133   IF(PGAIN.LT.1.)GO TO 135                                          12800000   

      PGAIN=PGAIN/10.0                                                  12810000   

      MGAIN=MGAIN*10.0                                                  12820000   

      GO TO 133                                                         12830000   

135   IF(PGAIN.GE.0.1.OR.MGAIN.LT.10.0)GO TO 137                        12840000   

      PGAIN=PGAIN*10.0                                                  12850000   

      MGAIN=MGAIN/10.0                                                  12860000   

137   INPUT=ITABLE(1,II)                                                12870000   

      ICINPT=ISIGN(1,INPUT)                                             12880000   

      INPUT=IABS(INPUT)                                                 12890000   

      IF(INPUT/NMBIAS.EQ.POT)GO TO 150                                  12900000   

      IF(PGAIN.EQ.1.0)GO TO 160                                         12910000   

      MOD=MODULE+(POT-NAME)*NMBIAS                                      12920000   

      CALL GETMOD(MOD)                                                  12930000   

      PTABLE(1,PNEXT)=MOD                                               12940000   

      PTABLE(2,PNEXT)=IPOSN                                             12950000   

      PTABLE(3,PNEXT)=0                                                 12960000   

      PTABLE(4,PNEXT)=0                                                 12970000   

      IF(PNEXT.GE.PSIZE)CALL ERROR 1(220,&1)                            12980000   

      ITABLE(1,IPOSN)=2+ICODE                                           12990000   

      ITABLE(2,IPOSN)=PNEXT                                             13000000   

      PNEXT=PNEXT+1                                                     13010000   

      PTABLE(1,PNEXT)=0                                                 13020000   

      IF(IPOSN+2.GT.ISIZE)CALL ERROR 1(221,&1)                          13030000   

      IPOSN=IPOSN+1                                                     13040000   

      ITABLE(1,IPOSN)=ITABLE(1,II)                                      13050000   

      ITABLE(1,II)=MOD*ICINPT                                           13060000   

      TABLEI(2,II)=MGAIN                                                13070000   

      TABLEI(2,IPOSN)=PGAIN                                             13080000   

      IPOSN=IPOSN+1                                                     13090000   

      ITABLE(1,IPOSN)=0                                                 13100000   

      GO TO 160                                                         13110000   

150   PP=0                                                              13120000   

152   PP=PP+1                                                           13130000   

      PTAB=PTABLE(1,PP)                                                 13140000   

      IF(PTAB            .EQ.INPUT)GO TO 155                            13150000   

      IF(PTAB.NE.0)GO TO 152                                            13160000   

      CALL ERROR1(222,&1)                                               13170000   

155   III=PTABLE(2,PP)+1                                                13180000   

      TABLEI(2,III)=TABLEI(2,III)*PGAIN                                 13190000   

      TABLEI(2,II)=MGAIN                                                13200000   

160   CONTINUE                                                          13210000   

      GO TO 130                                                         13220000   

      END                                                               13230000   

$ENTRY                                                                  13240000   

**********     SCALE         *******************************************13250000   

C&                                                                      13260000   

C  SCAL                                                                 13270000   

      SUBROUTINE SCALE                                                  13280000   

CCCC  SUB SCALE DOES;                                                   13290000   

CCCC      1-COLLECTS NSF AND BETA ARGUMENTS                             13300000   

CCCC      2-SCALES THE DIAGRAM                                          13310000   

CCCC      3-INFORMS THE USER OF THE BETA USED                           13320000   

C     OVERHEAD                                                          13330000   

      INTEGER*4 PTABLE(4,50),PNEXT,ITABLE(2,150),IPOSN,OTABLE(6,50)     13340000   

     2,OPOINT                                                           13350000   

      REAL*4 TABLEI(2,150),TABLEO(6,50)                                 13360000   

      EQUIVALENCE(ITABLE(1,1),TABLEI(1,1)),(OTABLE(1,1),TABLEO(1,1))    13370000   

      COMMON/TABLES/PTABLE,PNEXT,ITABLE,IPOSN,OTABLE,OPOINT             13380000   

      INTEGER*4 EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE,RFVOLT    13390000   

     2,ICODE,NMBIAS                                                     13400000   

      COMMON/STANDS/EXACT,FIX,PSIZE,ISIZE,OSIZE,MSIZE,NSIZE,BSIZE       13410000   

     2,RFVOLT,ICODE,NMBIAS                                              13420000   

      INTEGER*4 CODEW,WORD(2),CHINXT                                    13430000   

      REAL*4 NUMBER                                                     13440000   

      EQUIVALENCE(WORD(2),NUMBER)                                       13450000   

      COMMON/CSEARC/CODEW,WORD,CHINXT                                   13460000   

      INTEGER*2 ELATCH                                                  13470000   

      COMMON/CEXEC/ELATCH                                               13480000   

      INTEGER*4 NCODE,BCODE                                             13490000   

      REAL*4 TABLEN(10),TABLEB(10)                                      13500000   

      COMMON/SCALEC/TABLEN,TABLEB,NCODE,BCODE                           13510000   

      INTEGER*4 MTABLE(2,50)                                            13520000   

      REAL*4 TABLEM(2,50)                                               13530000   

      EQUIVALENCE(MTABLE(1,1),TABLEM(1,1))                              13540000   

      COMMON/MSCANC/MTABLE                                              13550000   

      INTEGER*2 MUL/4/,DIV/5/,SQRT/7/,SQ/6/,POT/12/                     13560000   

      LOGICAL LOG,SWITCH,INSCAL                                         13570000   

      REAL*4 MAX,MIN, NSF,MARGIN/100./,BETA/0./,LWGAIN/.1/,HIGAIN/10./  13580000   

      INTEGER*4 SUM,OUTPUT,PASS,START                                   13590000   

      DATA SUM,INT/2,1/                                                 13600000   

C     PROGRAMME                                                         13610000   

CCCC  *****DUMMY THE MTABLE*****                                        13620000   

CCCC  *****                                                             13630000   

      I=0                                                               13640000   

      PRINT,'  THIS IS THE MTABLE'                                      13650000   

      PRINT,'   MODULE        MAX'                                      13660000   

7777  I=I+1                                                             13670000   

      READ,MTABLE(1,I),TABLEM(2,I)                                      13680000   

      PRINT,MTABLE(1,I),TABLEM(2,I)                                     13690000   

      IF(MTABLE(1,I).NE.0)GO TO 7777                                    13700000   

CCCC  *****                                                             13710000   

CCCC  *****THIS IS THE DUMMY END*****                                   13720000   

5     CALL NLINE1(START)                                                13730000   

      IF(START.EQ.4)GO TO 8                                             13740000   

      CALL NLINE2                                                       13750000   

C                                                        ERROR   150    13760000   

      IF(START.NE.7)CALL ERROR(150,&1)                                  13770000   

6     CALL SEARCH(START)                                                13780000   

      CONTINUE                                                          13790000   

CCCC  ******MUST DO SOMETHING ABOUT COLLECTING INPUTS                   13800000   

      GO TO 5                                                           13810000   

CCCC  THE ERROR ROUTINE RETURNS HERE                                    13820000   

1     GO TO 5                                                           13830000   

CCCC  ENTER HERE IF THERE IS AN INPUT ON THE COMMAND CARD               13840000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 13850000   

      ENTRY SCALE1                                                      13860000   

      START=0                                                           13870000   

      GO TO 6                                                           13880000   

CCCC  PROCEDE TO SCALE IT                                               13890000   

8     IPOSN=0                                                           13900000   

      PNEXT=0                                                           13910000   

15    PNEXT=PNEXT+1                                                     13920000   

      MODULE=PTABLE(1,PNEXT)                                            13930000   

      IF(MODULE.EQ.0)GO TO 100                                          13940000   

      IF(.NOT.INSCAL(MODULE))GO TO 15                                   13950000   

C     FIND ITS MAXIMUM                                                  13960000   

30    CALL MSCAN(MODULE,MAX)                                            13970000   

      OUTPUT=PTABLE(3,PNEXT)                                            13980000   

      IF(OUTPUT.EQ.0)GOTO31                                             13990000   

      VALUE=TABLEO(6,OUTPUT)                                            14000000   

      IF(VALUE.NE.0)MAX=VALUE                                           14010000   

31    IF(MAX.LE.0)GO TO 28                                              14020000   

      NSF=1./MAX                                                        14030000   

      LOGIC=PTABLE(4,PNEXT)/EXACT                                       14040000   

      IF((LOGIC-(LOGIC/10)*10).EQ.1)GO TO 36                            14050000   

      CALL NORMAL(NSF)                                                  14060000   

36    IFIRST=PTABLE(2,PNEXT)                                            14070000   

      ILAST=IFIRST+ITABLE(1,IFIRST)-ICODE -1                            14080000   

      IFIRST=IFIRST+1                                                   14090000   

      DO 32 I=IFIRST,ILAST                                              14100000   

32    TABLEI(2,I)=TABLEI(2,I)*NSF                                       14110000   

      IPOSN=0                                                           14120000   

33    CALL ISCAN(MODULE)                                                14130000   

      IF(IPOSN.EQ.0)GOTO40                                              14140000   

      TABLEI(2,IPOSN)=TABLEI(2,IPOSN)/NSF                               14150000   

      GOTO33                                                            14160000   

C                                                        ERROR   160    14170000   

28    CALL WARN1(160)                                                   14180000   

      GO TO 15                                                          14190000   

CCCC  MODIFY NSF AND MAXIMUM ENTRIES IN OTABLE                          14200000   

40    IF(OUTPUT.EQ.0)GO TO 15                                           14210000   

      IF(TABLEO(5,OUTPUT).NE.0)GO TO 45                                 14220000   

      TABLEO(5,OUTPUT)=NSF                                              14230000   

42    VALUE=TABLEO(6,OUTPUT)                                            14240000   

      IF(VALUE.NE.0)TABLEO(6,OUTPUT)=VALUE*NSF                          14250000   

      GO TO 15                                                          14260000   

45    TABLEO(5,OUTPUT)=TABLEO(5,OUTPUT)*NSF                             14270000   

      GO TO 42                                                          14280000   

CCCC  NON-LINEAR MODULE GAIN ADJUSTER                                   14290000   

100   PNEXT=0                                                           14300000   

      SWITCH=.TRUE.                                                     14310000   

110   PNEXT=PNEXT+1                                                     14320000   

      MODULE=PTABLE(1,PNEXT)                                            14330000   

      IF(MODULE.EQ.0)GO TO 195                                          14340000   

      IF(INSCAL(MODULE))GO TO 110                                       14350000   

      NAME=MODULE/NMBIAS                                                14360000   

      IFIRST=PTABLE(2,PNEXT)                                            14370000   

      IF(NAME.EQ.POT)GO TO 150                                          14380000   

      GAIN=1.                                                           14390000   

      ILAST=ITABLE(1,IFIRST)-ICODE-1+IFIRST                             14400000   

      IFIRST=IFIRST+1                                                   14410000   

      LOG=.TRUE.                                                        14420000   

      DO 115 I=IFIRST,ILAST                                             14430000   

      TABI=TABLEI(2,I)                                                  14440000   

      IF(TABI.NE.1)LOG=.FALSE.                                          14450000   

115   GAIN=GAIN*TABI                                                    14460000   

      IF(LOG)GO TO 110                                                  14470000   

      IF(NAME.EQ.MUL.OR.NAME.EQ.DIV)GO TO 140                           14480000   

      IF(NAME.EQ.SQRT)GO TO 135                                         14490000   

      IF(NAME.EQ.SQ)GO TO 130                                           14500000   

      IF(GAIN.GT.1)GO TO 125                                            14510000   

CCCC  THEN GAIN .LT. 1                                                  14520000   

      WRITE(6,121) MODULE                                               14530000   

121   FORMAT(' **WARNING THE INPUT GAINS ASSOCIATED WITH ' I8           14540000   

     1 ' ARE LESS THAN UNITY. ATTENUATE INPUTS .' )                     14550000   

      GO TO 110                                                         14560000   

125   WRITE(6,126) MODULE                                               14570000   

126   FORMAT(' **ERROR  INPUT GAINS ASSOCIATED WITH 'I8 ' ARE GREATER ' 14580000   

     1 'THAN UNITY.' )                                                  14590000   

      GO TO 110                                                         14600000   

CCCC  MODULE IS SQUARER                                                 14610000   

130   GAIN=GAIN**2                                                      14620000   

      GO TO 140                                                         14630000   

CCCC  MODULE IS SQUARE-ROOTER                                           14640000   

135   GAIN=GAIN**(-2)                                                   14650000   

CCCC  FOR MULTIPLIERS AND DIVIDERS  ENTER HERE                          14660000   

140   IPOSN=0                                                           14670000   

142   CALL ISCAN(MODULE)                                                14680000   

      IF(IPOSN.EQ.0)GO TO 145                                           14690000   

      TABLEI(2,IPOSN)=TABLEI(2,IPOSN)*GAIN                              14700000   

      GO TO 142                                                         14710000   

145   WRITE(6,141) MODULE                                               14720000   

141   FORMAT(' **WARNING  MODULE 'I8' HAS BEEN SCALED')                 14730000   

      SWITCH=.FALSE.                                                    14740000   

      DO 148 I=IFIRST,ILAST                                             14750000   

148   TABLEI(2,I)=1.0                                                   14760000   

      GO TO 110                                                         14770000   

150   IFIRST=IFIRST+1                                                   14780000   

      GAIN=TABLEI(2,IFIRST)                                             14790000   

      IF(GAIN.LE.1)GO TO 110                                            14800000   

      ILAST=IFIRST                                                      14810000   

      GO TO 140                                                         14820000   

195   IF(.NOT.SWITCH)GO TO 100                                          14830000   

200   PASS=1                                                            14840000   

      IF(BETA.NE.0.)PASS=2                                              14850000   

      MAX=0.                                                            14860000   

      PNEXT=0                                                           14870000   

      MIN=10.**50                                                       14880000   

215   PNEXT=PNEXT+1                                                     14890000   

      MODULE=PTABLE(1,PNEXT)                                            14900000   

      IF(MODULE.EQ.0)GO TO 300                                          14910000   

      IF(MODULE/NMBIAS.NE.INT)GOTO215                                   14920000   

      IFIRST=PTABLE(2,PNEXT)                                            14930000   

      ILAST=IFIRST+ITABLE(1,IFIRST) -1-ICODE                            14940000   

      IFIRST=IFIRST+1                                                   14950000   

      IF(PASS.EQ.2)GOTO240                                              14960000   

      DO 233 IT=IFIRST,ILAST                                            14970000   

      IF(ITABLE(1,IT).LT.0)GO TO 233                                    14980000   

      ABSOL=ABS(TABLEI(2,IT))                                           14990000   

      IF(ABSOL.GT.MAX)MAX=ABSOL                                         15000000   

      IF(ABSOL.LT.MIN)MIN=ABSOL                                         15010000   

233   CONTINUE                                                          15020000   

      GOTO215                                                           15030000   

240   DO 243 IT=IFIRST,ILAST                                            15040000   

243   IF(ITABLE(1,IT).GT.0)TABLEI(2,IT)=TABLEI(2,IT)/BETA               15050000   

      GOTO215                                                           15060000   

C     CALCULATE BETA                                                    15070000   

300   IF(PASS.EQ.2)GOTO400                                              15080000   

      BETA=1.                                                           15090000   

      IF(MIN.LT.LWGAIN.OR.MAX.GT.HIGAIN)BETA=MAX/HIGAIN                 15100000   

      CALL CBETA(BETA)                                                  15110000   

      PASS=2                                                            15120000   

      PNEXT=0                                                           15130000   

      GOTO215                                                           15140000   

400   MAX=MAX/BETA                                                      15150000   

      MIN=MIN/BETA                                                      15160000   

      IF(MIN.EQ.0)GO TO 430                                             15170000   

      IF(MAX/MIN.GT.MARGIN)WRITE(6,410) MAX,MIN                         15180000   

410   FORMAT(' **WARNING     MAXIMUM INTEGRATOR GAIN = 'F12.6/14X,      15190000   

     1 ' MINIMUM INTEGRATOR GAIN = 'F12.6)                              15200000   

415   WRITE(6,420) BETA                                                 15210000   

420   FORMAT(' ANY TIME CONSTANTS OTHER THAN THOSE ASSOCIATED WITH'     15220000   

     1' INTEGRATORS SHOULD BE '/10X,'  ALTERED BY A FACTOR OF (BETA'    15230000   

     2')**-1'/14X'BETA ='F12.4)                                         15240000   

      CALL NLINE2                                                       15250000   

      RETURN                                                            15260000   

430   CALL WARN1(151)                                                   15270000   

      GO TO 415                                                         15280000   

      END                                                               15290000   

$ENTRY                                                                  15300000   

**********     SNOOP         *******************************************15310000   

C&                                                                      15320000   

C   SSV                                                                 15330000   

C     SCHNOUPIE SUPER-VISOR                                             15340000   

      L=1970                                                            15350000   

      K=1969                                                            15360000   

      K=1970                                                            15370000   

      L=1971                                                            15380000   

      DO 10 KT=1,20                                                     15390000   

      DO 10 I=K,L                                                       15400000   

      CALL SPACE (-2)                                                   15410000   

      CALL SPACE(15)                                                    15420000   

      CALL SNOOPY                                                       15430000   

      CALL SPACE(-1)                                                    15440000   

      CALL SPACE(6)                                                     15450000   

      CALL DATE(I)                                                      15460000   

10    CONTINUE                                                          15470000   

      CALL SPACE(-1)                                                    15480000   

      STOP                                                              15490000   

      END                                                               15500000   

C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15510000   

C&                                                                      15520000   

C  DATE                                                                 15530000   

      SUBROUTINE DATE(YEAR)                                             15540000   

      INTEGER*4 YEAR,DIGIT                                              15550000   

      INTEGER*4 CHARTS(2,7,11),FILE(2,7,4)                              15560000   

      DATA CHARTS/                                                      15570000   

     &'  1 ','    ',' 11 ','    ','  1 ','    ','  1 ',                 15580000   

     &'    ','  1 ','    ','  1 ','    ','1111','1   ',                 15590000   

     &' 222','    ','2   ','2   ','   2','    ','  2 ',                 15600000   

     &'    ',' 2  ','    ','2   ','    ','2222','2   ',                 15610000   

     &' 333','    ','3   ','3   ','    ','3   ','  33',                 15620000   

     &'    ','    ','3   ','3   ','3   ',' 333','    ',                 15630000   

     &'   4','    ','  44','    ',' 4 4','    ','4  4',                 15640000   

     &'    ','4444','4   ','   4','    ','   4','    ',                 15650000   

     &'5555','5   ','5   ','    ','5555','    ','    ',                 15660000   

     &'5   ','    ','5   ','5   ','5   ',' 555','    ',                 15670000   

     &' 666','    ','6   ','6   ','6   ','    ','6666',                 15680000   

     &'    ','6   ','6   ','6   ','6   ',' 666','    ',                 15690000   

     &'7777','7   ','    ','7   ','   7','    ','  7 ',                 15700000   

     &'    ',' 7  ','    ','7   ','    ','7   ','    ',                 15710000   

     &' 888','    ','8   ','8   ','8   ','8   ',' 888',                 15720000   

     &'    ','8   ','8   ','8   ','8   ',' 888','    ',                 15730000   

     &' 999','    ','9   ','9   ','9   ','9   ',' 999',                 15740000   

     &'9   ','    ','9   ','9   ','9   ',' 999','    ',                 15750000   

     &' 000','    ','0   ','0   ','0   ','0   ','0   ',                 15760000   

     &'0   ','0   ','0   ','0   ','0   ',' 000','    ',                 15770000   

     &'    ','    ','    ','    ','    ','    ','    ',                 15780000   

     &'    ','    ','    ','    ','    ','    ','    '   /              15790000   

      ISW=0                                                             15800000   

      K=1                                                               15810000   

      IU=6                                                              15820000   

      X=(FLOAT(YEAR)+0.5)/1000.0                                        15830000   

1     DIGIT=X                                                           15840000   

      X=(X-FLOAT(DIGIT))*10.                                            15850000   

      IF(DIGIT.NE.0)GO TO 10                                            15860000   

      DIGIT=10                                                          15870000   

      IF(ISW.NE.0)GO TO 5                                               15880000   

      DIGIT=11                                                          15890000   

5     GO TO 15                                                          15900000   

10    ISW=1                                                             15910000   

15    DO 20 I=1,7                                                       15920000   

      DO 20 II=1,2                                                      15930000   

20    FILE(II,I,K)=CHARTS(II,I,DIGIT)                                   15940000   

      K=K+1                                                             15950000   

      IF(K.LE.4)GO TO 1                                                 15960000   

      WRITE(IU,99)(((FILE(I,J,K),I=1,2),K=1,4),J=1,7)                   15970000   

99    FORMAT(//  7(52X,8A4/))                                           15980000   

      CALL SPACE(2)                                                     15990000   

      CALL KALNDR(I)                                                    16000000   

      RETURN                                                            16010000   

      END                                                               16020000   

C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16030000   

C&                                                                      16040000   

C  SNPY                                                                 16050000   

      SUBROUTINE SNOOPY                                                 16060000   

C      SCHNOUPIE  KHALHANDHER                                           16070000   

      WRITE(6,1111)                                                     16080000   

      WRITE(6,1112)                                                     16090000   

      WRITE(6,1113)                                                     16100000   

      WRITE(6,1114)                                                     16110000   

      WRITE(6,1115)                                                     16120000   

      WRITE(6,1116)                                                     16130000   

      WRITE(6,1117)                                                     16140000   

      WRITE(6,1118)                                                     16150000   

      WRITE(6,1119)                                                     16160000   

      WRITE(6,1120)                                                     16170000   

      WRITE(6,1121)                                                     16180000   

      WRITE(6,1122)                                                     16190000   

      WRITE(6,1123)                                                     16200000   

 1111 FORMAT(  ////39X,5H00000/37X,2H00,4X,6H000000/36X,2H00,7X,5H00  0/16210000   

     134X,17H000  000000  00 0/33X,19H0000 000000000 00 0/31X,22H00000 016220000   

     20000000000 0 00,27X,9H000000000/30X,24H00 00 000000000000  0 00,2316230000   

     3X,3H000,9X,3H000/28X,26H00  00  0000000000000  000,21X,2H00,15X,2H16240000   

     400/27X,27H00   00 000000000000000 000,19X,2H00,19X,1H0/25X,2H00,5X16250000   

     5,22H00 000000000000000 000,17X,2H00,22X,1H0/24X,2H00,6X,24H0  000016260000   

     60000000000  00000,13X,2H00,25X,1H0/23X,2H00,7X,26H0  000000000000016270000   

     70  00  000,8X,3H000,28X,1H0/22X,2H00,8X,20H0   0000000000000  0,6X16280000   

     8,9H000000000,31X,1H0/22X,1H0,9X,20H0   000000000000   0,47X,1H0/2116290000   

     9X,1H0,10X,19H0    0000000000   0,49X,7H0 00000)                   16300000   

 1112 FORMAT(21X,1H0,10X,1H0,5X,12H00000000   0,6X,2H00,42X,8H000   00/216310000   

     10X,2H00,11X,1H0,5X,10H000000   0,7X,3H000,42X,1H0,5X,1H0/20X,1H0,116320000   

     22X,1H0,12X,3H000,7X,4H0000,41X,8H0 000  0/19X,2H00,13X,1H0,9X,4H0016330000   

     3 0,8X,4H0000,41X,8H000000 0/19X,2H00,14X,2H00,5X,5H00  0,10X,3H00016340000   

     4,42X,7H00000 0/19X,1H0,14X,12H00000000   0,11X,3H000,42X,7H000000016350000   

     5/18X,2H00,14X,3H000,8X,1H0,12X,2H00,42X,7H0000000/18X,2H00,13X,3H016360000   

     6 0,9X,1H0,56X,6H000000/18X,2H00,13X,3H0 0,9X,1H0,55X,6H0 0000/18X,16370000   

     72H00,12X,3H0 0,9X,1H0,56X,1H0/18X,2H00,12X,3H0 0,9X,1H0,25X,11H00016380000   

     800000000,19X,1H0/18X,2H00,10X,4H00 0,10X,1H0,21X,4H0000,10X,6H000016390000   

     900,12X,2H00)                                                      16400000   

 1113 FORMAT(18X,2H00,8X,6H000000,10X,1H0,19X,2H00,20X,12H000000000000/116410000   

     18X,2H00,7X,1H0,6X,1H0,9X,1H0,18X,1H0/18X,2H00,7X,1H0,7X,1H0,7X,2H016420000   

     20,17X,1H0/18X,2H00,7X,1H0,7X,1H0,7X,1H0,17X,1H0/18X,2H00,7X,1H0,7X16430000   

     3,1H0,7X,1H0,16X,1H0/19X,1H0,7X,1H0,8X,1H0,6X,1H0,16X,1H0/19X,1H0,716440000   

     4X,1H0,8X,1H0,6X,1H0,15X,1H0/19X,1H0,8X,1H0,7X,1H0,6X,1H0,15X,1H0/116450000   

     59X,2H00,7X,1H0,7X,1H0,6X,1H0,15X,1H0,33X,6H000000/19X,2H00,8X,1H0,16460000   

     66X,1H0,6X,1H0,15X,1H0,39X,2H00/19X,2H00,8X,2H00,5X,1H0,6X,2H00,14X16470000   

     7,1H0,40X,2H00/19X,2H00,9X,6H0    0,7X,2H00,14X,1H0/20X,2H00,9X,4H016480000   

     8000,9X,1H0,14X,1H0/21X,1H0,22X,1H0,14X,1H0/21X,2H00,21X,1H0,15X,1H16490000   

     90/21X,2H00,21X,1H0,15X,1H0,34X,4H0000)                            16500000   

 1114 FORMAT(22X,1H0,21X,1H0,16X,1H0,28X,11H00000   000/22X,2H00,20X,1H016510000   

     1,17X,1H0,26X,14H0    0  00  00/23X,1H0,20X,1H0,18X,1H0,24X,15H0   16520000   

     2  0  0  000/23X,2H00,20X,1H0,18X,1H0,9X,4H0000,10X,16H0     00 0 016530000   

     3   0/24X,1H0,20X,1H0,19X,13H000000000   0,10X,1H0,9X,11H0     0   16540000   

     40/24X,2H00,19X,1H0,31X,1H0,10X,1H0,9X,12H0000  0    0/25X,1H0,19X,16550000   

     51H0,31X,1H0,11X,2H00,6X,13H00   0 0    0/25X,2H00,19X,1H0,29X,1H0,16560000   

     612X,2H00,11X,8H00     0/26X,2H00,18X,2H00,27X,2H00,11X,2H00,12X,8H16570000   

     700     0/27X,1H0,19X,1H0,26X,2H00,11X,2H00,13X,1H0,6X,1H0/28X,1H0,16580000   

     819X,1H0,23X,2H00,12X,2H00,14X,1H0,6X,1H0/29X,1H0,19X,1H0,11X,2H00,16590000   

     95X,4H0000,13X,2H00,9X,6H000000,6X,1H0)                            16600000   

 1115 FORMAT(30X,1H0,19X,1H0,10X,7H0000000,16X,2H00,8X,2H00,11X,2H00/30X16610000   

     1,2H00,19X,1H0,10X,1H0,20X,2H00,8X,2H00,11X,2H00/31X,3H000,18X,3H0016620000   

     20,6X,2H00,19X,2H00,8X,2H00,12X,1H0/33X,4H0000,15X,11H00000000000,116630000   

     38X,2H00,8X,2H00/35X,28H00000000000000000000    0000,17X,2H00,8X,2H16640000   

     400/50X,14H0     000    0,15X,2H00,8X,2H00/51X,5H0  00,7X,1H0,14X,216650000   

     5H00,8X,2H00/51X,3H000,9X,2H00,12X,2H00,8X,2H00/52X,2H00,10X,1H0,1116660000   

     6X,2H00,8X,2H00/51X,3H000,7X,5H00000,9X,2H00,8X,2H00/51X,15H0 0    16670000   

     7 000   0,8X,2H00,8X,2H00/50X,25H0  0   000      0      00,8X,2H00/16680000   

     850X,8H0 000000,8X,8H0    000,9X,1H0/49X,7H0  0 00,11X,5H0  00,10X,16690000   

     91H0/49X,6H0  0 0,13X,3H000,10X,2H00)                              16700000   

 1116 FORMAT(48X,7H0  0 00,13X,1H0,11X,2H00/48X,7H0  0 00,14X,2H00,8X,2H16710000   

     100/47X,9H0  0  0 0,15X,1H0,7X,1H0/47X,9H0  0  0 0,16X,7H0     0/4616720000   

     2X,10H0  0  0 00,17X,6H00   0/46X,9H0  0  0 0,20X,3H0 0/45X,10H0  016730000   

     3   0 0,21X,2H00/45X,10H0 00   0 0,23X,3H000/44X,11H0  0   00 0,25X16740000   

     4,3H000/44X,11H0 00    0 0,27X,3H000/43X,11H0  0     00,31X,1H0/43X16750000   

     5,11H0  0    0 0,32X,1H0/42X,12H0  00    0 0,33X,1H0/42X,11H0  0   16760000   

     6 000,35X,1H0/42X,11H0 00    0 0,36X,1H0/41X,12H0  0     0 0,8X,1H016770000   

     7,27X,1H0/41X,12H0  0    0  0,8X,1H0,28X,1H0/40X,14H0   0   00 0 0,16780000   

     87X,2H00,27X,2H00/40X,14H0  0    00 0 0,8X,1H0,28X,1H0/39X,16H0   016790000   

     9    00 0  0,7X,2H00,28X,1H0)                                      16800000   

 1117 FORMAT(39X,16H0  0     0 00  0,8X,1H0,28X,2H00/38X,17H0   0    00 16810000   

     10   0,8X,1H0,29X,1H0/38X,18H0  00    00 0    0,8X,1H0,28X,1H0/37X,16820000   

     219H0   0    0 0 0    0,8X,1H0,29X,1H0/37X,19H0  0     000 0    0,816830000   

     3X,2H00,28X,1H0/36X,21H0   0    0  0 0    00,8X,1H0,28X,2H00/36X,2116840000   

     4H0  0     0   00     0,9X,1H0,28X,1H0/36X,21H0  0    0  0  0     016850000   

     5,9X,5H0 000,24X,1H0/36X,22H0 0     0  0 00     00,9X,5H0   0,23X,216860000   

     6H00/35X,23H00 0     0  0  0      0,14X,1H0,23X,1H0/35X,24H0 00    16870000   

     7 0  0  0      00,14X,1H0,22X,1H0/35X,16H0 00    0  0   0,7X,1H0,1416880000   

     8X,1H0,22X,2H00/35X,16H0 0     0  0   0,7X,1H0,14X,1H0,22X,2H00/35X16890000   

     9,16H0 0     0  0   0,7X,2H00,12X,1H0,24X,1H0)                     16900000   

 1118 FORMAT(34X,25H0  0     0  0   0      00,14X,1H0,23X,1H0/34X,24H0  16910000   

     10    0  0    0      0,15X,1H0,23X,1H0/34X,24H0  0    0  0    0    16920000   

     2  0,15X,2H00,22X,1H0/34X,24H0 0     0  0    00     0,15X,1H0,23X,116930000   

     3H0/33X,26H0  0    0   0     0      0,14X,1H0,23X,2H00/33X,26H0  0 16940000   

     4   0  0      0      0,13X,1H0,24X,2H00/32X,29H0   0   0   0      016950000   

     50      00,8X,3H000,25X,2H00/32X,37H0       0   0       0        0 16960000   

     6     0,28X,2H00/32X,1H0,7X,4H0  0,8X,1H0,9X,6H00  00,29X,1H0/32X,116970000   

     7H0,6X,5H0   0,8X,1H0,10X,3H000,31X,1H0/32X,1H0,6X,5H0   0,9X,1H0,416980000   

     82X,2H00/31X,1H0,11X,1H0,9X,1H0,42X,1H0/31X,1H0,11X,1H0,9X,2H00,41X16990000   

     9,1H0/31X,1H0,11X,1H0,10X,1H0,40X,1H0)                             17000000   

 1119 FORMAT(30X,1H0,11X,1H0,11X,2H00,38X,2H00/30X,1H0,11X,1H0,12X,1H0,317010000   

     17X,2H00/29X,2H00,11X,1H0,12X,2H00,35X,2H00/29X,1H0,12X,1H0,13X,2H017020000   

     20,33X,2H00/29X,1H0,12X,1H0,14X,1H0,32X,2H00/28X,1H0,12X,1H0,16X,2H17030000   

     300,29X,2H00/28X,1H0,12X,1H0,17X,2H00,26X,4H00 0/27X,2H00,12X,1H0,117040000   

     49X,4H0000,25X,1H0/27X,1H0,13X,1H0,23X,1H0,13X,1H0,10X,1H0/27X,1H0,17050000   

     512X,1H0,24X,1H0,12X,1H0,11X,1H0/26X,1H0,13X,1H0,24X,1H0,12X,1H0,1217060000   

     6X,1H0/25X,1H0,14X,1H0,24X,1H0,12X,2H00,11X,1H0/16X,9H000000000,14X17070000   

     7,1H0,25X,1H0,12X,2H00,11X,1H0/14X,9H000000000,16X,1H0,25X,1H0,13X,17080000   

     81H0,11X,11H00000000000/13X,2H00,24X,1H0,25X,1H0,13X,1H0,22X,7H000017090000   

     9000)                                                              17100000   

 1120 FORMAT(1X,2H00,6X,5H00000,24X,1H0,26X,1H0,13X,12H000000000000,18X,17110000   

     13H000/3X,11H000000    0,24X,1H0,26X,1H0,14X,2H00,8X,6H000000,16X,217120000   

     2H00/6X,1H0,6X,1H0,23X,1H0,26X,1H0,31X,3H000,14X,2H00/10X,5H00000,217130000   

     32X,1H0,25X,1H0,34X,2H00,14X,2H00/1X,14H00000 000    0,21X,1H0,23X,17140000   

     43H000,37X,6H00   0,9X,1H0/6X,1H0,7X,1H0,21X,1H0,20X,3H000,41X,6H0 17150000   

     5   0,8X,1H0/14X,1H0,20X,1H0,19X,3H000,44X,6H0    0,8X,1H0/9X,6H00017160000   

     60 0,20X,1H0,17X,3H000,47X,6H0    0,7X,1H0/2X,13H00000000   00,20X,17170000   

     71H0,15X,2H00,40X,1H0,9X,6H0    0,6X,1H0/1X,1H0,12X,1H0,19X,1H0,15X17180000   

     8,2H00,42X,1H0,9X,5H0   0,5X,2H00/8X,7H000   0,18X,1H0,16X,1H0,33X,17190000   

     91H0,10X,1H0,8X,11H0   0000000)                                    17200000   

 1121 FORMAT(3X,11H00000   000,17X,2H00,17X,1H0,33X,2H00,9X,1H0,8X,4H00017210000   

     10/1X,2H00,10X,19H0  000000000     00,17X,2H00,34X,2H00,8X,1H0,7X,217220000   

     2H00/6X,10H0000000000,8X,5H00000,20X,3H000,34X,2H00,6X,10H000   00017230000   

     30/2X,4H0000,46X,49H0000000000000000000000000000000000000000000 00017240000   

     400/1X,1H0,87X,3H000    //////1X,3HI I,110X,3HI I/1X,3HI I,110X,3HI17250000   

     5 I/1X,116HI I  CCC  U   U RRRR   SSS  EEEEE    Y   Y  OOO  U   U  17260000   

     6    RRRR  EEEEE DDDD     BBBB   AAA  RRRR   OOO  N   N   I I/5X,1017270000   

     76HC   C U   U R   R S   S E        Y   Y O   O U   U      R   R E 17280000   

     8    D   D    B   B A   A R   R O   O NN  N)                       17290000   

 1122 FORMAT(5X,106HC     U   U R   R S     E        Y   Y O   O U   U  17300000   

     1    R   R E     D   D    B   B A   A R   R O   O NN  N/5X,106HC   17310000   

     2  U   U R   R S     E        Y   Y O   O U   U      R   R E     D 17320000   

     3  D    B   B A   A R   R O   O N N N/5X,106HC     U   U RRRR   SSS17330000   

     4  EEEE      YYY  O   O U   U      RRRR  EEEE  D   D    BBBB  AAAAA17340000   

     5 RRRR  O   O N N N/5X,106HC     U   U R  R      S E          Y   O17350000   

     6   O U   U      R  R  E     D   D    B   B A   A R  R  O   O N N N17360000   

     7/5X,106HC     U   U R   R     S E          Y   O   O U   U      R 17370000   

     8  R E     D   D    B   B A   A R   R O   O N  NN)                 17380000   

 1123 FORMAT(5X,109HC   C U   U R   R S   S E          Y   O   O U   U  17390000   

     1    R   R E     D   D    B   B A   A R   R O   O N  NN ../5X,109H 17400000   

     2CCC   UUU  R   R  SSS  EEEEE      Y    OOO   UUU  I    R   R EEEEE17410000   

     3 DDDD     BBBB  A   A R   R  OOO  N   N ../56X,1HI/55X,1H/)       17420000   

      RETURN                                                            17430000   

      END                                                               17440000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 17450000   

C&                                                                      17460000   

C  PACE                                                                 17470000   

      SUBROUTINE SPACE (N)                                              17480000   

      IF(N)7,1,4                                                        17490000   

4     DO 5 I=1,N                                                        17500000   

5      WRITE(6,6)                                                       17510000   

      GO TO 1                                                           17520000   

7     IN=-N                                                             17530000   

      DO 8 I=1,IN                                                       17540000   

8     WRITE(6,9)                                                        17550000   

1      RETURN                                                           17560000   

6      FORMAT(' ')                                                      17570000   

9      FORMAT('1')                                                      17580000   

      END                                                               17590000   

C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 17600000   

C&                                                                      17610000   

C  KALN                                                                 17620000   

      SUBROUTINE KALNDR(YEAR)                                           17630000   

      LOGICAL LEAP                                                      17640000   

      INTEGER*4 PYEAR,YEAR,SDAY,NOUGHT,NUMB(31),DAYS,ROW,M(12),D        17650000   

     2,W(12,6,7)                                                        17660000   

      DATA NOUGHT/'    '/                                               17670000   

      DATA M/31,28,31,30,31,30,31,31,30,31,30,31/                       17680000   

     2,NUMB/' 1 ',' 2 ',' 3 ',' 4 ',' 5 ',' 6 ',' 7 ',' 8 ',' 9 ',      17690000   

     3 '10 ','11 ','12 ','13 ','14 ','15 ','16 ','17 ','18 ','19 ',     17700000   

     4 '20 ','21 ','22 ','23 ','24 ','25 ','26 ','27 ','28 ','29 ',     17710000   

     5 '30 ','31'/                                                      17720000   

      LEAP=.FALSE.                                                      17730000   

      LEAPS=YEAR/4                                                      17740000   

      LREM=YEAR-LEAPS*4                                                 17750000   

      IF(LREM.EQ.0)LEAP=.TRUE.                                          17760000   

C     NOW FOR THE STARTING DAY                                          17770000   

      PYEAR=YEAR-1969                                                   17780000   

      IF(PYEAR.LT.0)PYEAR=PYEAR-3                                       17790000   

      SDAY=3+YEAR-1969+PYEAR/4                                          17800000   

      SDAY=SDAY-(SDAY/7)*7                                              17810000   

C     SUNDAY=0,SAT.=6                                                   17820000   

      IF(SDAY.LT.0)SDAY=7+SDAY                                          17830000   

      SDAY=SDAY+1                                                       17840000   

C     SUN=1,SAT=7                                                       17850000   

C                                                                       17860000   

C     NOW SET ALL DAYS TO BLANK                                         17870000   

       DO 10 I=1,7                                                      17880000   

      DO 10 J=1,12                                                      17890000   

      DO 10 K=1,6                                                       17900000   

10    W(J,K,I)=NOUGHT                                                   17910000   

CC    LETS GO                                                           17920000   

      DO 1000 MT=1,12                                                   17930000   

      DAYS=M(MT)                                                        17940000   

      IF(MT.EQ.2.AND.LEAP)DAYS=DAYS+1                                   17950000   

      ROW=1                                                             17960000   

      DO 1000 D=1,DAYS                                                  17970000   

      W(MT,ROW,SDAY)=NUMB(D)                                            17980000   

      SDAY=SDAY+1                                                       17990000   

      IF(SDAY.NE.8)GO TO 1000                                           18000000   

      SDAY=1                                                            18010000   

      ROW=ROW+1                                                         18020000   

1000  CONTINUE                                                          18030000   

      WRITE(6,199)                                                      18040000   

      WRITE(6,399)                                                      18050000   

      WRITE(6,299)(((W(IM,IR,ID),ID=1,7),IM =1,6),IR=1,6)               18060000   

      WRITE(6,499)                                                      18070000   

      WRITE(6,399)                                                      18080000   

      WRITE(6,299)(((W(IM,IR,ID),ID=1,7),IM =7,12),IR=1,6)              18090000   

      WRITE(6,599)                                                      18100000   

199   FORMAT(///5X,'J A N U A R Y',8X,'F E B R U A R Y',10X,'M A R C H',18110000   

     2 13X,'A P R I L',15X,'M A Y',15X,'J U N E'/)                      18120000   

299   FORMAT(6(' ',7A3))                                                18130000   

399   FORMAT(' ',6(' S  M  T  W  T  F  S  '))                           18140000   

499   FORMAT(//8X,'J U L Y',13X,'A U G U S T',8X,'S E P T E M B E R',7X 18150000   

     2,'O C T O B E R',8X,'N O V E M B E R',7X,'D E C E M B E R'/)      18160000   

599   FORMAT(129X,'RH')                                                 18170000   

      RETURN                                                            18180000   

      END                                                               18190000   

**********     TATODK        *******************************************18200000   

//HOLDEN   JOB 'T0173FIELD.HO,T=(,19)',MSGLEVEL=1,CLASS=T               18210000   

// EXEC  PGM=IEHMOVE                                                    18220000   

//SYSPRINT DD SYSOUT=A                                                  18230000   

//SYSUT1   DD UNIT=2314,VOL=SER=777777,DISP=SHR                         18240000   

//DD1      DD UNIT=2314,VOL=SER=ENG111,DISP=SHR                         18250000   

//TAPE     DD UNIT=2400,VOL=(PRIVATE,RETAIN,SER=HOLDEN),DISP=(OLD,KEEP) 18260000   

//SYSIN    DD *                                                         18270000   

#COPY PDS=T0173.FIELD.XXX,FROM=2400=(HOLDEN,1),TO=2314=ENG111,RENAME=ZZ 18280000   

/*                                                                      18290000   

**********     TEMP.NE       *******************************************18300000   

C& NLINE  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18310000   

CPRINTOFF                                                               18320000   

      SUBROUTINE NLINE(START)                                           18330000   

C     GETS NEW LINE,RETURNS INPUT IN INTERNAL CODE WITHOUT BLANKS OR    18340000   

C     COMMENTS (LEADING BLANKS EXCEPTED )                               18350000   

      COMMON/DIAGMC/SCOUNT                                              18360000   

      INTEGER*2 HLINE(80),BLANKS(80),INPUT(80),PNTR,SCOUNT              18370000   

      COMMON/CERROR/HLINE,BLANKS,INPUT,PNTR                             18380000   

      INTEGER*2 HPOINT,IPOINT,BLANKC,CHI,POINT/37/                      18390000   

     1,H(62),QUOTE/61/,CC/3/,BLANK/60/,STAR/51/,SLASH/52/,STEND/39/,    18400000   

     2 HENTS/62/,STCONT/38/,ZERO/27/,COLON/59/,MINUS/50/,EE/5/,AND/43/  18410000   

      LOGICAL HOLL,SWITCH                                               18420000   

      DATA H/'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'18430000   

     2,'P','Q','R','S','T','U','V','W','X','Y','Z','0','1','2','3','4', 18440000   

     3'5','6','7','8','9','.',0,0,'=',')','!','&','\','>','<',0,0,'+',  18450000   

C     COLON=31296                                                       18460000   

     4'-','*','/',0,',','(',3*0,31296,     ' ',1H','#'/                 18470000   

      INTEGER*2 HOLERI(80),OUTPNT,HB/' '/,NUMB/62/, INTERN(15),PACK/64/ 18480000   

      COMMON /COUTPT/ HOLERI,OUTPNT                                     18490000   

      INTEGER*4 START,DFBIAS/1048576/,EXP                               18500000   

      INTEGER*4 CODEW,WORD(2),CHINXT ,LINEL                             18510000   

      REAL*4 NUMBER,LOG                                                 18520000   

      EQUIVALENCE(WORD(2),NUMBER),(EXP,INTEG)                           18530000   

      COMMON/CGENL/CODEW,WORD,CHINXT ,LINEL                             18540000   

      INTEGER*2 ITITLE(80)                                              18550000   

      COMMON/CTITLE/ITITLE                                              18560000   

CCC   NLINE MAINLINE                                                    18570000   

10    READ(5,11)(HLINE(I),I=1,80)                                       18580000   

11    FORMAT(80A1)                                                      18590000   

      WRITE(6,12)(HLINE(I),I=1,80)                                      18600000   

12    FORMAT(' ',6X,80A1)                                               18610000   

20    HPOINT=0                                                          18620000   

      SCOUNT=0                                                          18630000   

      IPOINT=0                                                          18640000   

      START=0                                                           18650000   

      BLANKC=0                                                          18660000   

      HOLL=.FALSE.                                                      18670000   

30    HPOINT=HPOINT+1                                                   18680000   

      CHI=HLINE(HPOINT)                                                 18690000   

      IF(CHI.EQ.H(QUOTE))GOTO 35                                        18700000   

40    IF(HOLL)GOTO100                                                   18710000   

      IF(CHI.EQ.H(CC))GOTO55                                            18720000   

      IF(CHI.EQ.H(BLANK))GOTO100                                        18730000   

      IF(CHI.EQ.H(STAR))GOTO57                                          18740000   

      IF(CHI.EQ.H(SLASH))SCOUNT=SCOUNT+1                                18750000   

60    IF(START.EQ.0)START=HPOINT                                        18760000   

      I=0                                                               18770000   

70    I=I+1                                                             18780000   

      IF(CHI.EQ.H(I))GOTO 72                                            18790000   

      IF(I.LT.HENTS)GO TO 70                                            18800000   

C     H( ) CONTAINS 'HENTS' CHARACTERS                                  18810000   

      I=60                                                              18820000   

C     SET UNKNOWN CHARACTERS TO 'BLANKS                                 18830000   

72    CHI=I                                                             18840000   

90    IPOINT=IPOINT+1                                                   18850000   

      INPUT(IPOINT)=CHI                                                 18860000   

      BLANKS(IPOINT)=BLANKC                                             18870000   

95    IF(HPOINT.NE.72)GOTO30                                            18880000   

      INPUT(IPOINT+1)=STEND                                             18890000   

      BLANKS(IPOINT+1)=BLANKC                                           18900000   

      INPUT(IPOINT+2)=STAR                                              18910000   

      BLANKS(IPOINT+2)=BLANKC+1                                         18920000   

      RETURN                                                            18930000   

35    IF(HOLL)GOTO37                                                    18940000   

      HOLL=.TRUE.                                                       18950000   

      GOTO100                                                           18960000   

37    HOLL=.FALSE.                                                      18970000   

100   IF(START.EQ.0)GOTO 110                                            18980000   

      BLANKC=BLANKC+1                                                   18990000   

      GO TO 95                                                          19000000   

110   CHI=BLANK                                                         19010000   

      GO TO 90                                                          19020000   

55    IF(HPOINT-1)10,10,60                                              19030000   

57    IF(HPOINT.NE.72)GOTO60                                            19040000   

      CHI=STCONT                                                        19050000   

      GO TO 90                                                          19060000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 19070000   

      ENTRY NLINE1(START)                                               19080000   

CCCC  READS WITHOUT PRINTING                                            19090000   

130   READ(5,11)(HLINE(I),I=1,80)                                       19100000   

CC    MUST OUTPUT THE LINE IF IT IS A COMMENT                           19110000   

      IF(HLINE(1).EQ.H(CC))GO TO 135                                    19120000   

      GO TO 20                                                          19130000   

135   WRITE(6,12)(HLINE(I),I=1,80)                                      19140000   

      GO TO 130                                                         19150000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 19160000   

      ENTRY NLINE2                                                      19170000   

CCCC  WRITES LINE                                                       19180000   

      WRITE(6,12)(HLINE(I),I=1,80)                                      19190000   

      RETURN                                                            19200000   

C                                                                       19210000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 19220000   

      ENTRY TITLE                                                       19230000   

150   DO 155 J=9,80                                                     19240000   

155   ITITLE(J)=HLINE(J)                                                19250000   

      RETURN                                                            19260000   

CCC   GENLIN                                               GENLIN       19270000   

C *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   * 19280000   

CCCC                                         GENLIN                     19290000   

C                                                                       19300000   

      ENTRY GENLIN(START)                                               19310000   

200   IF(START.NE.0)OUTPNT=START-1                                      19320000   

      INTPNT=1                                                          19330000   

      INTERN(1)=CHINXT                                                  19340000   

208   IF(IABS(CODEW)-1)260,210,230                                      19350000   

CCCC  CONVERT VARIABLES BELOW                                           19360000   

210   IF(CODEW.GT.0)GO TO 215                                           19370000   

      DIFF=WORD(1)/DFBIAS                                               19380000   

      WORD(1)=WORD(1)-DIFF*DFBIAS                                       19390000   

      IF(DIFF.EQ.0)GO TO 215                                            19400000   

      IT=DIFF-IFIX(DIFF/10)*10+ZERO                                     19410000   

      INTPNT=INTPNT+1                                                   19420000   

      INTERN(INTPNT)=IT                                                 19430000   

      IT=DIFF/10                                                        19440000   

      IF(IT.EQ.0)GO TO 212                                              19450000   

      INTPNT=INTPNT+1                                                   19460000   

      INTERN(INTPNT)=IT+ZERO                                            19470000   

212   INTPNT=INTPNT+1                                                   19480000   

      INTERN(INTPNT)=COLON                                              19490000   

215   DO 220 I=1,2                                                      19500000   

      IWORD=WORD(3-I)                                                   19510000   

      DO 220 J=1,5                                                      19520000   

      IT=IWORD-(IWORD/PACK)*PACK                                        19530000   

      IF(IT.EQ.0)GO TO 260                                              19540000   

      INTPNT=INTPNT+1                                                   19550000   

      INTERN(INTPNT)=IT                                                 19560000   

220   IWORD=IWORD/PACK                                                  19570000   

      GO TO 260                                                         19580000   

CCC   THIS SECTION CREATES NUMBERS                                      19590000   

230   ANUMB=ABS(NUMBER)                                                 19600000   

      IF(ANUMB.LT.9.99995.AND.ANUMB.GE.9.99995E-2.OR.ANUMB.EQ.0.)GOTO25019610000   

      LOG=ALOG10(ANUMB)                                                 19620000   

      EXP=LOG+0.00001                                                   19630000   

      IF(LOG.LT.0.0.AND.EXP.NE.0)EXP=EXP-1                              19640000   

      NUMBER=NUMBER*10.0**(-EXP)                                        19650000   

      IF(EXP.EQ.0)GO TO 250                                             19660000   

      EXP=IABS(EXP)                                                     19670000   

      IT=EXP-(EXP/10)*10+ZERO                                           19680000   

      EXP=EXP/10                                                        19690000   

      INTPNT=INTPNT+1                                                   19700000   

      INTERN(INTPNT)=IT                                                 19710000   

      IF(EXP.EQ.0)GO TO 235                                             19720000   

      INTPNT=INTPNT+1                                                   19730000   

      INTERN(INTPNT)=EXP+ZERO                                           19740000   

235   IF(LOG.GT.0.0)GO TO 240                                           19750000   

      INTPNT=INTPNT+1                                                   19760000   

      INTERN(INTPNT)=MINUS                                              19770000   

240   INTPNT=INTPNT+1                                                   19780000   

      INTERN(INTPNT)=EE                                                 19790000   

250   SWITCH=.TRUE.                                                     19800000   

      NUMBER=NUMBER*10.0**4                                             19810000   

      INTEG=ABS(NUMBER)+0.5                                             19820000   

      DO 255 I=1,4                                                      19830000   

      IT=INTEG-(INTEG/10)*10                                            19840000   

      INTEG=INTEG/10                                                    19850000   

      IF(IT.EQ.0.AND.SWITCH.AND.I.NE.4)GO TO 255                        19860000   

      SWITCH=.FALSE.                                                    19870000   

      INTPNT=INTPNT+1                                                   19880000   

      INTERN(INTPNT)=IT+ZERO                                            19890000   

255   CONTINUE                                                          19900000   

      INTPNT=INTPNT+1                                                   19910000   

      INTERN(INTPNT)=POINT                                              19920000   

      INTPNT=INTPNT+1                                                   19930000   

      INTERN(INTPNT)=INTEG+ZERO                                         19940000   

      IF(NUMBER.GE.0)GO TO 260                                          19950000   

      INTPNT=INTPNT+1                                                   19960000   

      INTERN(INTPNT)=MINUS                                              19970000   

CCCC  GENERATE HOLLERITH AS FOLLOWS                                     19980000   

260   DO 265 I=1,INTPNT                                                 19990000   

      IT=INTERN(I)                                                      20000000   

      IF(IT.LE.0.OR.IT.GT.HENTS)IT=AND                                  20010000   

265   INTERN(I)=H(IT)                                                   20020000   

CCCC  AND PACK IT IN OUTPUT BUFFER LIKE THIS                            20030000   

      IF(OUTPNT+INTPNT.LE.LINEL)GO TO 270                               20040000   

      CALL OUTLIN                                                       20050000   

      OUTPNT=15                                                         20060000   

270   DO 275 I=1,INTPNT                                                 20070000   

      OUTPNT=OUTPNT+1                                                   20080000   

275   HOLERI(OUTPNT)=INTERN(INTPNT+1-I)                                 20090000   

      RETURN                                                            20100000   

      END                                                               20110000   

$ENTRY                                                                  20120000   

**********     TPTODK        *******************************************20130000   

//HOLDEN   JOB 'T0173FIELD.HO,T=(,19)',MSGLEVEL=1,CLASS=T               20140000   

// EXEC  PGM=IEHMOVE                                                    20150000   

//SYSPRINT DD SYSOUT=A                                                  20160000   

//SYSUT1   DD UNIT=2314,VOL=SER=777777,DISP=SHR                         20170000   

//DD1      DD UNIT=2314,VOL=SER=ENG111,DISP=SHR                         20180000   

//TAPE     DD UNIT=2400,VOL=(PRIVATE,RETAIN,SER=HOLDEN),DISP=(OLD,KEEP) 20190000   

//SYSIN    DD *                                                         20200000   

#COPY PDS=T0173.FIELD.XXX,FROM=2400=(HOLDEN,1),TO=2314=ENG111,RENAME=ZZ 20210000   

/*                                                                      20220000   

**********   END OF FILE     *******************************************20230000   
