Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C TRANSGENERATION - MAIN PROGRAM MARCH 21, 1966
C THIS IS A SIFTED VERSION OF BMD09S ORIGINALLY WRITTEN IN
C FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
C IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
CPROGRAM FLOW-
C 1. DETERMINE TYPE OF INPUT AND READ IN VARIABLE INPUT FORMAT CARDS
C A) PUNCHED INPUT- PREPARE BRANCHES AND LISTING
C B) BINARY TAPE INPUT- PREPARE BRANCHES AND LISTING, CHECK JIN
C C) BCD TAPE INPUT- PREPARE BRANCHES AND LISTING
C D) NON-PUNCHED INPUT- PREPARE BRANCHES AND CHECK MIN
C E) LIST METHOD OF INPUT
C F) NON-BINARY INPUT- PREPARE BRANCHES, CHECK JIN, LIST FORMAT
C 2. DETERMINE TYPES OF OUTPUT, READ IN VARIABLE OUTPUT FORMATS
C A) PRINTED OUTPUT- PREPARE BRANCHES AND LISTINGS, CHECK JPRT
C B) PUNCHED OUTPUT- PREPARE BRANCHES AND LISTINGS, CHECK JPNCH AND
C NPUNCH
C C) BINARY OUTPUT- PREPARE BRANCHES AND LISTINGS, CHECK JTAPE
C D) BCD OUTPUT- PREPARE BRANCHES AND LISTINGS, CHECK JTAPE
C E) TAPE OUTPUT- CHECK MIN
C F) NON-TAPE OUTPUT- PREPARE BRANCH
C G) LIST METHODS OF OUTPUT
C H) LIST TYPE AND NUMBER OF OUTPUT TAPE
C I) READ AND LIST APPROPRIATE FORMAT CARDS
C 3. READ TRANSGENERATION CARDS, CHECK CONSTRAINTS, SAVE LOCATIONS OF
C ALL TYPE-18 AND -19 TRANSGENERATIONS, STORE TYPE-40 CONSTANTS
C 4. RUN THROUGH DATA FOR MEAN AND STANDARD DEVIATION COMPUTATIONS
C (IF DATA INPUT WAS FROM CARDS, IT IS WRITTEN ON TAPE 2)
C 5. CHECK THAT NO VARIABLE USED IN TYPE-18 OR -19 TRANSGENERATION IS
C CHANGED (UNLESS BY ANOTHER TYPE-18) BEFORE THAT TRANSGENERATION
C 6. CALL SUBROUTINE TRANS TO TRANSGENERATE, ONE CASE AT A TIME FROM
C TAPE, SAVE OLD AND NEW VARIABLES FOR FIRST AND LAST CASES
C 7. AFTER EACH CASE THE REQUESTED OUTPUTS ARE MADE
C 8. PRINT OUT OLD AND NEW VARIABLES FOR FIRST AND LAST CASES
CGUIDE TO FIRST LETTER IN FIXED-POINT VARIABLES-
C I TO DETERMINE TRANSFERS AND FOR OUTERMOST DO LOOPS
C J NUMBER OF VARIABLE FORMAT CARDS (JIN,JPRT,JPNCH,JTAPE)
C K ALPHABETIC CONTROL WORDS AND CHECKS ON SAME
C M TAPE NO. (MIN,MIN2,MOUT,MOUT1)
C N ALL OTHER VARIABLES (EXCEPT KODE)
CGUIDE TO DIMENSIONED VARIABLES-
C CONS= CONSTANTS IN TYPE-40 TRANSGEN. (ONLY 50 40'S PERMITTED)
C CONST= 2ND VARIABLE NO. OR REGULAR CONSTANT FOR TRANSGENERATIONS
C DATA= DATA (TRANSGENERATED ONE CASE AT A TIME FROM TAPE)
C FMT= VARIABLE INPUT FORMAT
C KODE= TYPE OF TRANSGENERATION
C NCON40= NUMBER OF TYPE-40 CONSTANTS
C NOTRAN= OLD VARIABLE TO BE TRANSGENERATED
C NSUM18= LOCATION OF CARDS HAVING TYPE-18 OR -19 TRANSGENERATIONS
C NTRAN= NEW VARIABLE AFTER TRANSGENERATION
C OUTPUT= USED FOR ALPHABETIC LISTING OF METHODS OF DATA OUTPUT
C PRINT= VARIABLE PRINT FORMAT
C PUNCH= VARIABLE PUNCH FORMAT
C SAMPL= USED TO SAVE OLD AND NEW VARIABLES FOR FIRST AND LAST CASES
C SUM18= USED FOR SUM OF SQUARES IN TYPE-19 TRANSGENERATIONS
C TAPE= VARIABLE BCD TAPE FORMAT
C TRAN40= USED FOR TEMPORARY STORAGE OF TYPE-40 CONSTANTS
CGUIDE TO PROBLEM CARD (WITH LIMITS OF PARAMETER VALUES)-
C PROB = IDENTIFIES PROBLEM CARD WITH WORD- PROBLM
C PRBM= ALPHANUMERIC USER'S PROBLEM NUMBER OR OTHER IDENTIFICATION
C NCASE= NUMBER OF CASES (LIMIT OF 130000)
C NVAR= NUMBER OF VARIABLES INPUTED (LIMIT OF 99)
C NADVAR= NUMBER OF VARIABLES ADDED BY TRANSGEN. (NVAR+NADVAR 99)
C NPUNCH= NO. OF VARIABLES PUNCHED/ BLANK IF SAME AS NOVAR (LIMIT99)
C NTRG= NUMBER OF TRANSGENERATION CARDS(LIMIT 99)
C AINPUT= CRD FOR PUNCHED INPUT, BCD FROM BCD TAPE, BIN FROM BIN.TAPE
C MIN= INPUT TAPE NO./ BLANK IF INPUT ON CARDS (LIMIT 16, NOT 5,6)
C PRNT= YES IF PRINT-OUT DESIRED/ OTHERWISE BLANK
C PNCH= YES IF PUNCHED CARD OUTPUT DESIRED/ OTHERWISE BLANK
C OUT= BCD FOR BCD TAPE OUTPUT, BIN FOR BINARY TAPE, IF NONE BLANK
C MOUT= OUTPUT TAPE NO./BLANK IF NONE (LIMIT OF 16, NOT 5 OR 6)
C JIN= NO. OF VARIABLE INPUT FORMAT CARDS/ BLANK IF BINARY INPUT
C JPRT= NO. OF VARIABLE PRINT FORMAT CARDS/ BLANK IF NO PRINT-OUT
C JPNCH= NO. OF VARIABLE PUNCH FORMAT CARDS/ BLANK IF NO PUNCHING
C JTAPE= NO. OF VARIABLE BCD FORMAT CARDS/ BLANK IF NO BCD OUTPUT
C (ALL VARIABLE FORMATS ARE LIMITED TO 10 CARDS)
CLIST OF VARIABLES NOT APPEARING IN DIMENSION OR PROBLEM CARD LISTS-
C IFPNCH WHETHER TO PUNCH OUTPUT
C IFPRT WHETHER TO PRINT OUTPUT
C IMIN2 WHETHER TO SET MIN=2 AFTER INPUT IS WRITTEN ON SCRATCH TAPE
C INOFMT WHETHER TO READ IN INPUT FORMAT CARDS
C INSAVE WHETHER TO SAVE NEW VARIABLES
C INTAP WHETHER BINARY OR BCD TAPE READ DURING MAIN DATA PASS
C INTAPE WHETHER BINARY OR BCD TAPE READ DURING PREPASS
C IPRINT WHETHER TO READ IN PRINT FORMAT CARDS
C IPUNCH WHETHER TO READ IN PUNCH FORMAT CARDS
C IREWND WHETHER TO REWIND INPUT TAPE
C ISAVE WHETHER TO CONTINUE MAIN LOOP OR BRANCH OUT LAST TIME
C ISPECL WHETHER TO SAVE OLD VARIABLES FOR LAST CASE
C ITAPE WHETHER BINARY OR BCD OR NO TAPE OUTPUT
C IWRTAP WHETHER TO READ IN BCD TAPE FORMAT CARDS
C IWRIT2 WHETHER TO WRITE PUNCHED INPUT ON SCRATCH TAPE AT PREPASS
C I1SAVE WHETHER TO SAVE OLD VARIABLES
C NCAS (NO. OF CASES)-1
C NLOC USED TO POSITION NAMES OF TYPES OF OUTPUT
C NLOC18 THE LOCATION OF CARDS WITH TYPE-18 OR 19 TRANSGENERATIONS
C NOVAR NUMBER OF VARIABLES AFTER TRANSGENERATION
C NUM18 COUNTS THE NUMBER OF TYPE-18 AND -19 TRANSGENERATIONS
C N18 THE VARIABLE USED IN A TYPE-18 OR -19 TRANSGENERATION
C N40 COUNTS THE NUMBER OF TYPE-40 TRANSGENERATIONS
C TEMP,TEMP1 NAME OF TYPE OF DATA INPUT
CGUIDE TO STATEMENT NUMBERING-
C 200'S TRANSFERS FROM IF AND COMPUTED GOTO STATEMENTS
C 300'S TRANSFERS FROM UNCONDITIONAL GOTO STATEMENTS
C 400'S END OF DO LOOPS (ORDERED BY THE ORDER OF BEGINNING NOT
C 500'S TRANSFERS FROM CHECKS ON PROBLM CARD (END OF LOOPS)
C 600'S TRANSFERS FROM ASSIGNED GOTO STATEMENTS
C 900'S ERROR OUTPUTS
C 950'S FORMAT STATEMENTS FOR ERROR OUTPUTS
C 1000'S FORMAT STATEMENTS FOR WRITE OUTPUTS
C 2000'S FORMAT STATEMENTS FOR READ INPUTS
DOUBLE PRECISION SAMPL
DOUBLE PRECISION PROB,PRBM,TRGN,OUTPUT,DATA
DOUBLE PRECISION A123,B123,C123
DOUBLE PRECISION TEMP,TEMP1,Q007HL,Q008HL,Q009HL,Q010HL,Q011HL,
1Q012HL, Q013HL,Q014HL
DIMENSION CONS(7,50),CONST(99),DATA(1500),FMT(180),KODE(99),NCON
140(50),NOTRAN(99),NSUM18(99),NTRAN(99),OUTPUT(6),PRINT(180),PUN
2CH(180),SAMPL(3,99),SUM18(99),TAPE(180),TRAN40(7)
COMMON DATA,CONS,CONST,KODE,NCASE,NCON40
COMMON NOTRAN , NTRAN , NTRG , NVAR
DATA A123,B123,C123,D123,E123,F123,G123/6HPROBLM,6HFINISH,6HTRNGEN
X,3HYES,3HBCD,3HBIN,3HCRD/
C
1001 FORMAT(39H1BMD09S - TRANSGENERATION - VERSION OF
114HMARCH 21, 1966/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//)
C
MIN2=5
MOUT1=6
CALL USAGEB('BMD09S')
C
C READ PROBLEM CARD
C
888 READ (5,2001) PROB, PRBM,NCASE,NVAR,NADVAR,NPUNCH, NTRG,AINPUT,MIN
1, PRNT, PNCH, OUT,MOUT,JIN,JPRT,JPNCH,JTAPE
2001 FORMAT(2A6,I6,I3,I4,2I3,A3,I2,3A3,I2,17X,4I2)
IF(PROB.EQ.B123)GO TO 999
IF(PROB.NE.A123)GO TO 903
501 WRITE (6,1001)
NOVAR=NVAR+NADVAR
WRITE (6,1002)PRBM,NCASE,NVAR,NOVAR,NTRG
1002 FORMAT(1H 18X,12HPROBLEM NO. A6/22H0THIS PROBLEM CONTAINSI6,29H
1 CASES. INITIALLY THERE ARE I3,34H VARIABLES, AFTER TRANSGENERATI
2ON-I3,11H VARIABLES./1H I3,33H TRANSGENERATIONS ARE TO BE MADE.)
REWIND 2
ASSIGN 1000 TO IREWND
ASSIGN 6093 TO KSKIP
ASSIGN 2475 TO ISKIP
IF(NCASE) 903,903,502
502 IF(NVAR) 903,903,503
503 IF(NOVAR) 903,903,504
504 IF(NTRG)903,5045,505
5045 ASSIGN 6096 TO KSKIP
ASSIGN 280 TO ISKIP
505 IF(NOVAR-99) 506,506,903
506 IF(NCASE-130000)507,507,903
C
C
CERROR OUTPUTS
C
900 WRITE (6,950)
950 FORMAT(48H0AN IMPROPER INPUT OR OUTPUT TAPE WAS SPECIFIED.)
GO TO 1000
901 WRITE (6,951)
951 FORMAT(49H0NO METHOD OF INPUT OR OUTPUT HAS BEEN SPECIFIED.)
GO TO 1000
902 WRITE (6,952)
952 FORMAT(82H0AN IMPROPER NUMBER OF FORMAT CARDS ARE CALLED FOR SOME
1INPUT OR OUTPUT OPERATION.)
GO TO 1000
903 WRITE (6,953)
953 FORMAT(47H0CONTROL CARDS MISPUNCHED OR CARDS OUT OF ORDER)
GO TO 1000
904 WRITE (6,954)
954 FORMAT(16H0A PROGRAM ERROR)
GO TO 1000
C
CEND OF PROGRAM
C
999 IF(MOUT1-6)297,299,297
297 END FILE MOUT1
296 REWIND MOUT1
299 GO TO IREWND,(699,1000)
699 IF(MIN2.LE.5)GO TO 1000
REWIND MIN2
1000 STOP
C
CPART 1
C
507 IF(AINPUT.NE.G123)GO TO 201
DATA Q007HL/6HPUNCH /
200 TEMP=(+Q007HL)
DATA Q008HL/6HCARDS /
TEMP1=(+Q008HL)
MIN=5
ASSIGN 600 TO INOFMT
ASSIGN 604 TO IWRIT2
GO TO 206
201 IF(AINPUT.NE.F123)GO TO 203
DATA Q009HL/6HBINARY/
202 TEMP=(+Q009HL)
DATA Q010HL/6H TAPE /
TEMP1=(+Q010HL)
ASSIGN 601 TO INOFMT
ASSIGN 602 TO INTAPE
ASSIGN 607 TO INTAP
IF(JIN)902,205,902
203 IF(AINPUT.NE.E123)GO TO 901
DATA Q011HL/6H BCD/
204 TEMP=(+Q011HL)
TEMP1=(+Q010HL)
ASSIGN 600 TO INOFMT
205 ASSIGN 605 TO IWRIT2
ASSIGN 699 TO IREWND
IF(MIN.EQ.0.OR.MIN.GE.17)GO TO 900
206 WRITE (6,1003)TEMP,TEMP1,MIN
1003 FORMAT(17H0INPUT DATA FROM 2A6,9H ON TAPE I2)
GO TO INOFMT,(600,601)
600 CALL VFCHCK(JIN)
C208 JIN=JIN*12
208 JIN=JIN*18
ASSIGN 603 TO INTAPE
ASSIGN 606 TO INTAP
C
C READ INPUT VARIBLE FORMAT
C
READ (5,2002)(FMT(I),I=1,JIN)
C2002 FORMAT(12A6)
2002 FORMAT(18A4)
WRITE (6,1004)(FMT(I),I=1,JIN)
C1004 FORMAT(21H THE INPUT FORMAT IS-/(1H ,12A6))
1004 FORMAT(21H THE INPUT FORMAT IS-/(1H ,18A4))
C
CPART 2
C
601 NLOC=2
IPRINT=0
IPUNCH=0
IWRTAP=3
IF(PRNT.NE.D123)GO TO 211
209 CALL VFCHCK(JPRT)
DATA Q012HL/6H PRINT/
210 OUTPUT(1)=(+Q012HL)
DATA Q013HL/6H, /
OUTPUT(2)=(+Q013HL)
NLOC=NLOC+2
IPRINT=1
C JPRT=JPRT*12
JPRT=JPRT*18
ASSIGN 612 TO IFPRT
GO TO 312
211 ASSIGN 613 TO IFPRT
312 IF(PNCH.NE.D123)GO TO 216
213 CALL VFCHCK(JPNCH)
214 OUTPUT(NLOC-1)=(+Q007HL)
DATA Q014HL/6HCARDS,/
OUTPUT(NLOC)=(+Q014HL)
NLOC=NLOC+2
IPUNCH=1
C JPNCH=JPNCH*12
JPNCH=JPNCH*18
ASSIGN 614 TO IFPNCH
IF(NPUNCH)215,215,217
215 NPUNCH=NOVAR
GO TO 217
216 ASSIGN 615 TO IFPNCH
217 IF(OUT.NE.F123)GO TO 219
218 OUTPUT(NLOC-1)=(+Q009HL)
OUTPUT(NLOC)=(+Q010HL)
IWRTAP=2
ASSIGN 617 TO ITAPE
IF(JTAPE) 902,222,902
219 IF(OUT.NE.E123)GO TO 224
220 CALL VFCHCK(JTAPE)
221 OUTPUT(NLOC-1)=(+Q011HL)
OUTPUT(NLOC)=(+Q010HL)
IWRTAP=1
C JTAPE=JTAPE*12
JTAPE=JTAPE*18
ASSIGN 616 TO ITAPE
222 IF(MOUT.EQ.0.OR.MOUT.EQ.2.OR.MOUT.EQ.5.OR.MOUT.EQ.6.OR.MOUT.GE.17)
XGO TO 900
GO TO 225
224 ASSIGN 618 TO ITAPE
NLOC=NLOC-2
IF(IPRINT+IPUNCH) 904,901,227
225 CALL TPWD2(MOUT,MOUT1)
227 WRITE (6,1005)(OUTPUT(I),I=1,NLOC)
1005 FORMAT(17H0DATA OUTPUT IS- 3(2A6,1X))
CALL TPWD(MIN,MIN2)
GO TO(231,231,232), IWRTAP
231 WRITE (6,1006)OUTPUT(NLOC-1),OUTPUT(NLOC),MOUT
1006 FORMAT(16H OUTPUT TAPE IS 2A6,3HNO.I3)
232 IF(IPRINT) 904,241,240
240 WRITE (6,1007)
1007 FORMAT(21H0THE PRINT FORMAT IS-)
READ (5,2002)(PRINT(I),I=1,JPRT)
WRITE (6,1008)(PRINT(I),I=1,JPRT)
C1008 FORMAT(1H ,12A6)
1008 FORMAT(1H ,18A4)
241 IF(IPUNCH) 904,244,242
242 WRITE (6,1009)
1009 FORMAT(35H0THE PUNCHED CARD OUTPUT FORMAT IS-)
READ (5,2002)(PUNCH(I),I=1,JPNCH)
WRITE (6,1008)(PUNCH(I),I=1,JPNCH)
244 GO TO (245,247,247),IWRTAP
245 WRITE (6,1010)
1010 FORMAT(31H0THE BCD OUTPUT TAPE FORMAT IS-)
READ (5,2002)(TAPE(I),I=1,JTAPE)
WRITE (6,1008)(TAPE(I),I=1,JTAPE)
C
CPART 3
C
247 NUM18=0
N40=0
GO TO ISKIP,(2475,280)
2475 WRITE (6,1011)
1011 FORMAT(1H06X21H TRANSGENERATOR CARDS/5H0CARD4X3HNEW5X5HTRANS4X
1 20HORIG. ORIG. VAR(B)10X,17HTYPE 40 CONSTANTS/45H NO. VARIABLE
2 CODE VAR(A) OR CONSTANT)
DO 400 I=1,NTRG
READ (5,2003) TRGN,NTRAN(I),KODE(I),NOTRAN(I),CONST(I), NCONS,(TRA
1N40(J),J=1,7)
2003 FORMAT(A6,I3,I2,I3,F6.0,5X,I1,7F6.0)
IF(TRGN.NE.C123)GO TO 903
248 IF(KODE(I)*(KODE(I)-27))249,905,251
249 IF(KODE(I).NE.18.AND.KODE(I).NE.19)GO TO 255
250 NUM18=NUM18+1
NSUM18(NUM18)=I
SUM18(I)=0
CONST(I)=0
GO TO 255
251 IF(KODE(I)-40)905,252,2515
2515 IF(KODE(I)-42)255,252,254
252 IF(NCONS.EQ.0.OR.NCONS.GE.8)GO TO 905
253 N40=N40+1
DO 401 II=1,NCONS
401 CONS(II,N40)=TRAN40(II)
NCON40(N40)=NCONS
WRITE (6,1012)I,NTRAN(I),KODE(I),NOTRAN(I),CONST(I), (CONS(II,N40)
1,II=1,NCONS)
1012 FORMAT(1H ,I3,I8,2I9,F15.5,5X5F14.5/50X,2F14.5)
GO TO 400
254 IF(KODE(I).EQ.43)GO TO 255
905 WRITE (6,955)
955 FORMAT(112H0THE FOLLOWING TRANSGENERATION CARD HAS ILLEGAL CODE NU
1MBER OR NUMBER OF TYPE-40 CONSTANTS. IT WILL BE SKIPPED.)
WRITE (6,1013)I,NTRAN(I),KODE(I),NOTRAN(I),CONST(I)
1013 FORMAT(1H ,I3,I8,2I9,F15.5)
WRITE (6,1020)
1020 FORMAT(1H0)
KODE(I)=44
GO TO 400
255 WRITE (6,1013)I,NTRAN(I),KODE(I),NOTRAN(I),CONST(I)
400 CONTINUE
WRITE (6,1020)
IF(N40.LE.50)GO TO 260
906 WRITE (6,956)
956 FORMAT(65H0MORE THAN 50 TYPE-40 TRANSGENERATIONS. PROGRAM CANNOT
1CONTINUE.)
GO TO 999
260 IF(NUM18) 904,280,261
C
CPART 4
C
261 ASSIGN 624 TO IMIN2
NCASE1=NCASE
265 NCASE2=MOD(NCASE1,32767)
IF(NCASE2.EQ.0)NCASE2=32767
DO 402 I=1,NCASE2
GO TO INTAPE,(602,603)
602 READ (MIN)(DATA(II),II=1,NVAR)
GO TO 605
603 READ (MIN,FMT)(DATA(II),II=1,NVAR)
GO TO IWRIT2,(604,605,622)
604 ASSIGN 622 TO IWRIT2
ASSIGN 623 TO IMIN2
622 WRITE (2)(DATA(II),II=1,NVAR)
605 DO 402 I18=1,NUM18
NLOC18=NSUM18(I18)
N18=NOTRAN(NLOC18)
IF(KODE(NLOC18)-18) 904,402,275
275 SUM18(NLOC18)=DATA(N18)*DATA(N18)+SUM18(NLOC18)
402 CONST(NLOC18)=DATA(N18)+CONST(NLOC18)
NCASE1=NCASE1-NCASE2
IF(NCASE1.GT.0)GO TO 265
GO TO IMIN2,(623,624)
623 MIN=2
ASSIGN 607 TO INTAP
ASSIGN 699 TO IREWND
END FILE MIN
624 REWIND MIN
DO 403 I18=1,NUM18
NLOC18=NSUM18(I18)
CASE=NCASE
IF(KODE(NLOC18)-18) 904,277,278
277 CONST(NLOC18)=CONST(NLOC18)/CASE
GO TO 403
278 CONST(NLOC18)=(SUM18(NLOC18)-((CONST(NLOC18)*CONST(NLOC18))/CASE))
1/(CASE-1.0)
CONST(NLOC18)=SQRT(CONST(NLOC18))
403 CONTINUE
C
CPART 5
C
DO 404 K=1,NTRG
DO 404 KK=1,NUM18
NLOC18=NSUM18(KK)
IF(NTRAN(K).NE.NOTRAN(NLOC18).OR.K.GE.NLOC18.OR.KODE(K).EQ.18)GO
XTO 404
907 WRITE (6,957)K,NTRAN(K),KODE(NLOC18),NSUM18(KK),KODE(NLOC18)
957 FORMAT(25H0TRANSGENERATION CARD NO.I4,17H CHANGES VARIABLEI4,
139H BEFORE THAT VARIABLE IS USED IN A TYPEI3/44H TRANSGENERATION O
2N TRANSGENERATION CARD NO.I4,12H. THIS TYPEI3,37H TRANSGENERATION
3 WILL BECOME INVALID.)
404 CONTINUE
C
CPART 6
C
280 ASSIGN 405 TO ISAVE
ASSIGN 608 TO I1SAVE
ASSIGN 610 TO INSAVE
ASSIGN 619 TO ISPECL
NCAS=NCASE-1
NVA=NVAR+1
IF(NCAS) 903,281,282
281 I=1
ASSIGN 621 TO ISAVE
GO TO 383
282 NCASE1=NCAS
285 NCASE2=MOD(NCASE1,32767)
IF(NCASE2.EQ.0)NCASE2=32767
DO 405 I=1,NCASE2
383 DO 406 J=NVA,NOVAR
SAMPL(1,J)=0.0
SAMPL(3,J)=0.0
406 DATA(J)=0.0
GO TO INTAP,(606,607)
606 READ (MIN,FMT)(DATA(II),II=1,NVAR)
GO TO 384
607 READ (MIN)(DATA(II), II=1,NVAR)
384 GO TO ISPECL,(619,620)
619 GO TO I1SAVE,(608,609)
608 DO 407 J=1,NVAR
407 SAMPL(1,J)=DATA(J)
ASSIGN 609 TO I1SAVE
GO TO 609
620 DO 408 J=1,NVAR
408 SAMPL(3,J)=DATA(J)
609 GO TO KSKIP,(6093,6096)
6093 CALL TRANS(I)
6096 GO TO INSAVE,(610,611)
610 DO 409 J=1,NOVAR
409 SAMPL(2,J)=DATA(J)
ASSIGN 611 TO INSAVE
C
CPART 7
C
611 GO TO IFPRT,(612,613)
612 WRITE (6,1014)I
1014 FORMAT(9H CASE NO.I6)
WRITE (6,PRINT)(DATA(J),J=1,NOVAR)
613 GO TO IFPNCH,(614,615)
614 PUNCH PUNCH,(DATA(J),J=1,NPUNCH)
615 GO TO ITAPE,(616,617,618)
616 WRITE (MOUT,TAPE)(DATA(J),J=1,NOVAR)
GO TO 618
617 WRITE (MOUT)(DATA(J),J=1,NOVAR)
618 GO TO ISAVE,(405,621)
405 CONTINUE
NCASE1=NCASE1-NCASE2
IF(NCASE1.GT.0)GO TO 285
ASSIGN 620 TO ISPECL
ASSIGN 621 TO ISAVE
I=NCASE
GO TO 383
C
CPART 8
C
621 WRITE (6,1015)NCASE, NCASE
1015 FORMAT(62H1SAMPLE LISTING OF VARIABLES BEFORE AND AFTER TRANSGENER
1ATION.//13H VARIABLE NO.7X,17H CASE 1 BEFORE4X,16H CASE 1 AF
2TER 12X,6H CASEI6,7H BEFORE4X,4HCASEI6,6H AFTER/ 23X,15HTRAN
3SGENERATION5X,15HTRANSGENERATION14X,15HTRANSGENERATION5X,15HTRANSG
4ENERATION/)
DO 410 I=1,NOVAR
410 WRITE (6,1016)I,SAMPL(1,I),SAMPL(2,I),SAMPL(3,I),DATA(I)
1016 FORMAT(1H I8,F26.6,F20.6,F30.6,F21.6)
GO TO 888
END
SUBROUTINE TPWD(NT1,NT2)
C SUBROUTINE TPWD FOR BMD09S MARCH 21, 1966
C
IF(NT1)40,10,12
10 NT1=5
12 IF(NT1-NT2)14,19,14
14 IF(NT2.EQ.5)GO TO 19
15 REWIND NT2
19 IF(NT1-5)18,24,18
18 IF(NT1-6)22,40,22
22 REWIND NT1
24 NT2=NT1
28 RETURN
40 WRITE (6,49)
STOP
49 FORMAT(25H ERROR ON TAPE ASSIGNMENT)
END
SUBROUTINE TPWD2(NT1,NT2)
C SUBROUTINE TPWD2 FOR BMD09S MARCH 21, 1966
C
IF(NT1-NT2)14,28,14
14 IF(NT2.EQ.0.OR.NT2.EQ.6)GO TO 22
16 END FILE NT2
15 REWIND NT2
22 REWIND NT1
24 NT2=NT1
28 RETURN
END
SUBROUTINE TRANS(NOCASE)
C SUBROUTINE TRANS FOR BMD09S-DATA RECODE MARCH 21, 1966
DIMENSION CONS(7,50),CONST(99),DATA(1500),KODE(99),NCON40(50),
1NOTRAN(99),NTRAN(99)
DOUBLE PRECISION DATA
COMMON DATA,CONS,CONST,KODE,NCASE,NCON40
COMMON NOTRAN , NTRAN , NTRG , NVAR
EXTERNAL SIGN
ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
C
II=0
DO 110 I=1,NTRG
N=NOTRAN(I)
M=NTRAN(I)
D2 = DATA(M)
K=KODE(I)
D1=DATA(N)
C=CONST(I)
NEWB=C
IF(K.NE.18 .AND. K.NE.19) D3 = DATA(NEWB)
GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,
124, 25, 26,198,198,198,198,198,198,198,198,198,198,198,198,198,
2 170,175,170,175,100),K
1 IF(D1)198,107,108
107 D2=0.0
GOTO100
108 D2=SQRT(D1)
GOTO100
2 IF(D1)198,111,112
111 D2=1.0
GOTO100
112 D2=SQRT(D1)+SQRT(D1+1.0)
GOTO100
3 IF(D1.LE.0.0)GO TO 198
114 D2=ALOG10(D1)
GOTO100
4 D2=EXP(D1)
GOTO100
5 IF(D1)198,107,117
117 IF(D1.GE.1.0)GO TO 119
118 D2=ASN(SQRT(D1))
GOTO100
119 D2=3.14159265/2.0
GOTO100
6 FN=NCASE
A=D1/(FN+1.0)
B=A+1.0/(FN+1.0)
IF(A) 198,123,124
123 IF(B)198,107,127
127 D2=ASN(SQRT(A))
GOTO100
124 IF(B)198,128,129
128 D2=ASN(SQRT(A))
GOTO100
129 D2=ASN(SQRT(A))+ASN(SQRT(B))
GOTO100
7 IF(D1.EQ.0.0)GO TO 198
131 D2=1.0/D1
GOTO100
8 D2=D1+C
GOTO100
9 D2=D1*C
GOTO100
10 IF(D1)198,107,133
133 D2=D1**C
GOTO100
11 D2=D1+D3
GOTO100
12 D2=D1-D3
GOTO100
13 D2=D1*D3
GOTO100
14 IF(D3.EQ.0.0)GO TO 197
D2=D1/D3
GOTO100
15 IF(D1-C)107,111,111
16 IF(D1-D3)107,111,111
17 IF(D1.LE.0.0)GO TO 198
D2=ALOG(D1)
GO TO 100
18 D2=D1-C
GO TO 100
19 D2=D1/C
GO TO 100
20 D2=SIN(D1)
GO TO 100
21 D2=COS(D1)
GO TO 100
22 IF(D1.GT.1.57079632.OR.D1.LT.-1.57079632)GO TO 198
D2=ATAN(D1)
GO TO 100
23 IF(D1.LE.0.0)GO TO 198
D2=D1**D3
GO TO 100
24 IF(C.LE.0.0)GO TO 196
D2=C**D1
GO TO 100
25 D2=D1
GO TO 100
26 D2=C
GO TO 100
170 II=II+1
L=NCON40(II)
DO 166 J=1,L
IF(D1.NE.CONS(J,II))GO TO 166
E=SIGN(1.0,D1)
D=SIGN(1.0,CONS(J,II))
IF((E+D).NE.0.0)GO TO 167
166 CONTINUE
GO TO 100
175 IF(D1.NE.0.0)GO TO 110
E=SIGN(1.0,D1)
D=1.0
IF((E+D).NE.0.0)GO TO 110
167 JUMP=K-39
GO TO (26,26,43,43),JUMP
43 D2=D3
GO TO 100
196 WRITE(6,4000)
GO TO 199
197 N=NEWB
198 WRITE (6,201)N,NOCASE
199 WRITE (6,202)K,M
GO TO 110
100 DATA(M)=D2
110 CONTINUE
201 FORMAT(22H0THE VALUE OF VARIABLEI4,8H IN CASEI5)
4000 FORMAT(26H0THE VALUE OF THE CONSTANT)
202 FORMAT(54H VIOLATED THE RESTRICTIONS FOR TRANSGENERATION OF TYPEI3
X,1H./39H THE PROGRAM CONTINUED LEAVING VARIABLEI4,25H UNCHANGED FO
XR THIS CASE.)
RETURN
END
C SUBROUTINE TO CHECK FOR PROPER NUMBER OF VARIABLE FORMAT CRDS
SUBROUTINE VFCHCK(NVF)
C
IF(NVF.GT.0.AND.NVF.LE.10)GO TO 50
10 WRITE (6,4000)
NVF=1
50 RETURN
C
4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
1IED, ASSUMED TO BE 1.)
END