********** 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\0\6\\t!\\\0\\\\\\\\\\\0\\\\t<}&v\\\\\\0\\\\\\\\02170000 \TXT \\\ \\ \\\\\0\\\0\\\\\\\\\\\0\\\\t','<',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