C TITLE 'SIMPLE' IV
C SIMULATION PROBLEM-ORIENTED LANGAUGE FOR ENGINEERS
C B.P. MOLINARI,P.O. DUFTY,P.I. COOPER
C UNIVERSITY OF W.A.
C
C DIMENSIONING ARRAYS
COMMON NDEV1,NDEV2,LWIDTH
COMMON ISY,NTYPE,MPAR,KPAR,MM
COMMON NEQ,NH,NOUT,IOU
COMMON NPR(4,8),TTL(2,12),ARITH(6)
COMMON NDF(5,4),TP( 80),SYMB(50)
COMMON PAR(1000),VAL(1100),MAP(4000)
COMMON DFG(4,50)
DIMENSION CTROL(10,2),BLOCK(6,6),OUT(4)
DIMENSION ITEMP(30)
C 1. CONSTANTS SECTION
CTROL(1,1)=5HNEWJO
CTROL(1,2)=5HB
CTROL(2,1)=5HPROGR
CTROL(2,2)=5HAM
CTROL(3,1)=5HDATA
CTROL(4,1)=5HOUTPU
CTROL(4,2)=5HT
CTROL(5,1)=5HRUN
CTROL(6,1)=5HFINIS
CTROL(6,2)=5HH
CTROL(3,2)=5H
CTROL(5,2)=5H
BLANK=5H
BLOCK(1,1)=5HSQR
BLOCK(1,2)=5HEXP
BLOCK(1,3)=5HLN
BLOCK(1,4)=5HAT
BLOCK(1,5)=5HABS
BLOCK(1,6)=5HPOW
BLOCK(2,1)=5HMUL
BLOCK(2,2)=5HDIV
BLOCK(2,3)=5HSUM
BLOCK(2,4)=5HNEG
BLOCK(2,5)=5HERR
BLOCK(2,6)=5HSPL
BLOCK(3,1)=5HBB
BLOCK(3,2)=5HLIM
BLOCK(3,3)=5HDS
BLOCK(3,4)=5HIR
BLOCK(3,5) = 5HRFG
BLOCK(3,6)=5HRDH
BLOCK(4,1)=5HRES
BLOCK(4,3)=5HOR
BLOCK(5,1)=5HDFG
BLOCK(5,2)=5HDEL
BLOCK(6,1)=5HINT
BLOCK(6,2)=5HALG
BLOCK(6,3)=5HTRF
ARITH(1)=5H(
ARITH(2)=5H)
ARITH(3)=5H*
ARITH(4)=5H/
ARITH(5)=5H+
ARITH(6)=5H-
CONST=5HCONST
OUT(1)=5HTITLE
OUT(2)=5HINTVL
OUT(3)=5HPRINT
OUT(4)=5HWRITE
COMMA=5H,
JPRG=0
C 2. CONTROL SECTION
100 NTYPE=1
NDEV1=5
NDEV2=3
WRITE(NDEV1,101)
101 FORMAT(//)
CALL READ
110 DO 119 I1=1,6
DO 112 J1=1,2
IF(SYMB(J1)-CTROL(I1,J1))119,112,119
112 CONTINUE
N=NO(BLANK)
IF(N) 120,120,115
115 IF(I1-5) 116,117,117
116 NDEV1=N
DATRD=SYMB(3)
CALL IFILE(NDEV1,DATRD)
GO TO 120
117 NDEV2=N
RUNWR=SYMB(3)
CALL OFILE(NDEV2,RUNWR)
GO TO 120
119 CONTINUE
GO TO 190
120 GO TO (50,200,500,600,300,160),I1
160 STOP
180 WRITE(5,181)
181 FORMAT (26H**ILLEGAL COMMAND SEQUENCE)
GO TO 100
190 WRITE(5,191)
191 FORMAT (18H** ILLEGAL COMMAND)
GO TO 100
C 3. CLEAR SECTION
50 LEVEL=0
ISY=0
IOU=0
LPROG=0
IDF=0
60 DO 61 I=1,1000
61 PAR(I)=BLANK
DO 62 I=1,1100
62 VAL(I)=0.0
DO 63 I=1,4000
63 MAP(I)=0
DO 64 I=1,5
DO 64 J=1,4
64 NDF(I,J)=0
NDF(1,2)=1
DO 55 I=1,4
DO 55 J=1,50
55 DFG(I,J)=0.0
PAR(10)=5HT
VAL(9)=1.0
PAR(8)=5HXSTOP
PAR(7)=5HISTEP
VAL(7)=0.1
MM=100
MPAR=10
KPAR=1001
NEQ=1
MAP(1)=10
MAP(3901)=9
IF(JPRG) 70,70,65
65 WRITE(NDEV2,66)
66 FORMAT(1H1)
70 JPRG=JPRG+1
GO TO 100
C 4. SYSTEM DESCRIPTION SECTION
200 IF(LEVEL)180,201,180
201 LEVEL=1
205 NTYPE=2
CALL READ
IF(ISY) 205,224,224
224 IF(SYMB(1)-ARITH(3))225,240,225
225 IF(SYMB(1)-CONST)2000,230,2000
230 KPAR=KPAR+1-ISY
DO235 K=2,ISY
235 PAR(KPAR+K-2)=SYMB(K)
GO TO 205
240 CONTINUE
IF(LPROG) 241,2600,241
241 WRITE(5,242)
242 FORMAT(25H** ERRORS IN SYSTEM DESC.)
GO TO 100
245 GO TO 100
260 WRITE(5,261)
261 FORMAT (19H** NONVALID PROGRAM)
GO TO 100
2000 JI=0
IRT=0
2001 DO 2005I20=1,ISY
IF(SYMB(I20)-ARITH(1))2005,2010,2005
2005 CONTINUE
GO TO 2090
2010 DO 2015 I21=1,6
DO2015J21=1,6
IF(SYMB(I20-1)-BLOCK(I21,J21))2015,2020,2015
2015 CONTINUE
GO TO 2092
2020 J=J21
GO TO (2025,2025,2025,2050,2060,2070),I21
2025 N=JPAR(SYMB(1))
DO 2029 I=100,MM-1
IF(MAP(I))2029,2027,2029
2027 IF(MAP(I+3)-N)2029,2094,2029
2029 CONTINUE
DO2039I=1,NEQ
IF(MAP(I)-N)2039,2094,2039
2039 CONTINUE
IF(JI)2072,2040,2072
2040 MAP(MM+3)=N
MAP(MM+2)=J
MAP(MM+1)=I21
DO 2041 I=4,ISY-1
2041 MAP(MM+I)=JPAR(SYMB(I))
MM=MM+ISY
IF(IRT)2160,2045,2055
2045 IF(I21-5) 205,2215,205
2050 IRT=1
ISY=ISY-1
TMP =SYMB(1)
DO2051I=1,ISY
2051 SYMB(I)=SYMB(I+1)
GO TO 2025
2055 SYMB(1)= TMP
J=J+1
IRT=0
GO TO 2025
2060 IDF=IDF+1
NDF(IDF,1) = JPAR(SYMB(1))
NDF(IDF,3) = NDF(IDF,2) -1 +NO(BLANK)
IF(IDF-5) 2210,2210,2211
2210 NDF(IDF+1,2) = NDF(IDF,3) + 1
2211 ISY=ISY-1
GO TO 2025
2215 MAP(MM)=IDF
MM=MM+1
GO TO 205
2070 GO TO (2071,2100,2085,2085,2085,2085),J
2071 JI=1
GO TO 2025
2072 NEQ=NEQ+1
MAP(NEQ)=N
MAP(3900+NEQ)=JPAR(SYMB(4))
GO TO 205
2085 WRITE(NDEV2,2086)
2086 FORMAT(15X,33H * BLOCK TYPE NOT YET AVAILABLE )
LPROG=1
GO TO 205
2090 WRITE(NDEV2,2091)
2091 FORMAT(15X,20H * INCORRECT FORMAT)
LPROG=1
GO TO 205
2092 WRITE(NDEV2,2093)
2093 FORMAT(15X,23H * ILLEGAL BLOCK TYPE )
LPROG=1
GO TO 205
2094 WRITE(NDEV2,2095)
2095 FORMAT(15X,27H * OUTPUT ALREADY DEFINED )
LPROG=1
GO TO 205
2100 DO 2101 I=1,30
2101 TP(I) = SYMB(I)
IT = ISY
2110 DO 2119 IA=3,IT
IF(TP(IA) - ARITH(1)) 2111,2118,2111
2111 IF(TP(IA) - ARITH(2)) 2119,2115,2119
2115 LE = IA - 1
GO TO 2120
2118 LB = IA+1
2119 CONTINUE
GO TO 2090
2120 IF(LE-LB) 2690,2180,2121
2121 KOP = 1
DO 2129 JA=3,6
DO 2129 KA=LB,LE
IF(TP(KA) - ARITH(JA)) 2129,2130,2129
2129 CONTINUE
GO TO 2090
2130 GO TO (2690,2690,2140,2141,2142,2143),JA
2140 SYMB(2) = BLOCK(2,1)
GO TO 2150
2141 SYMB(2) = BLOCK(2,2)
GO TO 2150
2142 SYMB(2) = BLOCK(2,3)
GO TO 2150
2143 SYMB(2) = BLOCK(2,5)
2150 SYMB(1) = DPAR(IOU)
SYMB(3) = ARITH(1)
SYMB(4) = TP(KA-1)
2151 SYMB(4+KOP) = TP(KA-1+2*KOP)
IF(TP(KA+2*KOP) - ARITH(JA)) 2155,2152,2155
2152 KOP = KOP+1
GO TO 2151
2155 ISY = 5+KOP
SYMB(ISY) = ARITH(2)
IRT = -1
GO TO 2001
2160 TP(KA-1) = SYMB(1)
DO 2161 I=KA,IT
2161 TP(I)=TP(I+2*KOP)
IT = IT-2*KOP
LE = LE-2*KOP
GO TO 2120
2180 IF(LE-4) 2090,2185,2181
2181 TP(LB+1) = TP(LB)
DO 2182 I = LB+1,IT
2182 TP(I-2) = TP(I)
IT = IT-2
GO TO 2110
2185 N = JPAR(TP(1))
NI = JPAR(TP(4))
DO 2189 I=1,4000
IF(MAP(I) - NI) 2189,2186,2189
2186 MAP(I) = N
PAR(NI) = BLANK
2189 CONTINUE
GO TO 205
C SORTER SUBSECTION
2600 IND=0
IPASS=0
MSORT=100
MTBE=100
TYPE 9004
ACCEPT 9005,NY
Y=1HY
N=1HN
IF(NY .EQ. N) GO TO 2615
PRINT 9001,(MAP(I),I=1,4000)
PRINT 9002,(PAR(K),K=1,1000)
9001 FORMAT (8I14)
9002 FORMAT (15A5)
9004 FORMAT (' TYPE Y FOR STORAGE ARRAY OR N IF NOT REQUIRED'/)
9005 FORMAT (A1)
GO TO 2615
2611 IF(MTBE-MM)2615,2612,2612
2612 IF(IPASS)2613,2700,2613
2613 MTBE=MSORT
IPASS=0
2615 MTBS=MTBE
DO2619I=1,25
IF(MAP(MTBS+I))2619,2620,2619
2619 CONTINUE
GO TO 2690
2620 MTBE=MTBS+I
2621 DO2640I=MTBS+4,MTBE-1
IF(MAP(I) - KPAR) 2622,2640,2640
2622 IF(MAP(I) - 10) 2640,2640,2623
2623 DO2625J=1,MSORT-1
IF(MAP(I)-MAP(J))2625,2640,2625
2625 CONTINUE
IF(IND)2631,2611,2700
2631 ISY=ISY+1
SYMB(ISY)=PAR(MAP(I))
2640 CONTINUE
IF(IND)2710,2641,245
2641 DO2642I=1,MTBE-MTBS
2642 ITEMP(I)=MAP(MTBS+I)
DO2643I=1,MTBS-MSORT
2643 MAP(MTBE+1-I)=MAP(MTBS+1-I)
DO2644I=1,MTBE-MTBS
2644 MAP(MSORT+I)=ITEMP(I)
MSORT=MSORT+MTBE-MTBS
IPASS=IPASS+1
IF(MSORT-MM)2611,2650,2650
2650 IND=1
2651 MTBS=3897
MTBE=3901+NEQ
GO TO 2621
2690 WRITE(NDEV2,2691)
2691 FORMAT(10X,24H * THIS SHOULDNT HAPPEN)
GO TO 260
2700 WRITE(NDEV2,2701)
2701 FORMAT(//10X,21H ** NONVALID PROGRAM )
2702 WRITE(NDEV2,2703)
2703 FORMAT(//10X,47H * IMPLICIT LOOP AND/OR UNDEFINED BLOCK-INPUTS)
ISY=0
IF(IND)2690,2705,2706
2705 IND=-1
GO TO 2613
2706 IND=-2
GO TO 2651
2710 IF(ISY)2690,2720,2711
2711 WRITE(NDEV2,2712)(SYMB(I),I=1,ISY)
2712 FORMAT(A20,10A7)
ISY=0
2720 IF(IND+2)2690,260,2725
2725 IF(MM-MTBE)2690,2706,2615
C 5. DATA SECTION
500 IF(LEVEL-1)180,501,501
501 LEVEL=2
JDF=0
505 NTYPE = 3
CALL READ
520 IF(SYMB(1)-ARITH(3)) 521,570,521
521 DO 522 J=1,IDF
IF(JPAR(SYMB(2))-NDF(J,1)) 522,523,522
522 CONTINUE
JD=0
GO TO 530
523 JD=J
JDF=1
NE=NO(BLANK)
DO 526 I=1,LWIDTH
IF(TP(LWIDTH-I)-COMMA) 525,524,525
524 TP(LWIDTH-I)=BLANK
GO TO 527
525 TP(LWIDTH-I)=BLANK
526 CONTINUE
527 NS=NO(BLANK)
IF(NS) 528,529,529
528 NS=NE
529 ISY=2*(NE-NS+1)
530 READ(NDEV1,531)(TP(I),I=1,ISY)
531 FORMAT(20F)
532 WRITE(NDEV2,533)(TP(I),I=1,ISY)
533 FORMAT (15X,1P8E13.4)
535 IF(JD) 560,536,560
536 DO 550 I=1,ISY
N=JPAR(SYMB(I))
DO540J=1,NEQ
IF(N-MAP(J))540,545,540
540 CONTINUE
VAL(N)=TP(I)
GO TO 550
545 VAL(1000+J)=TP(I)
550 CONTINUE
GO TO 505
560 N1=NDF(JD,2)
DO 565 I=NS,NE
DFG(1,N1+I-1)=TP(2*(I-NS)+1)
565 DFG(2,N1+I-1)=TP(2*(I-NS)+2)
NDF(JD,4)=1
GO TO 505
570 IF(JDF) 100,100,571
571 DO 575 I=1,5
IF(NDF(I,4)) 572,575,572
572 DO 573 J=NDF(I,2),NDF(I,3)-1
TMP=DFG(1,J+1) - DFG(1,J)
DFG(3,J)=(DFG(2,J+1)-DFG(2,J))/TMP
573 DFG(4,J)=(DFG(1,J+1)*DFG(2,J)-DFG(1,J)*DFG(2,J+1))/TMP
DFG(4,NDF(I,3))=DFG(2,NDF(I,2))
NDF(I,4)=0
575 CONTINUE
GO TO 100
C 6. OUTPUT SECTION
600 IF(LEVEL-1)180,601,601
601 LEVEL=2
JPR=1
602 DO 603 I=1,4
NPR(I,1)=1
DO 603 J=2,8
603 NPR(I,J)=0
DO 604 I=1,2
DO 604 J=1,12
604 TTL(I,J)=BLANK
605 NTYPE=4
CALL READ
IF(SYMB(1)-ARITH(3))625,100,625
625 IF(SYMB(1)-OUT(1))626,640,626
626 IF(SYMB(1)-OUT(2))627,650,627
627 IF(SYMB(1)-OUT(3))628,659,628
628 IF(SYMB(1)-OUT(4))690,658,690
640 IF(TTL(1,1)-BLANK) 642,641,642
641 NTT=1
GO TO 645
642 NTT=2
645 DO 646 I=2,ISY
646 TTL(NTT,I-1) = SYMB(I)
GO TO 605
650 DO 651 I=JPR,4
651 NPR(I,1)=NO(BLANK)
GO TO 605
658 IFORM=0
GO TO 660
659 IFORM=+1
660 DO 665 I=2,ISY
665 NPR(JPR,I+1) = JPAR(SYMB(I))
JPR=JPR+1
IF(JPR - 5) 605,690,690
690 WRITE(NDEV2,691)
691 FORMAT(15X,31H * TOO MANY OUTPUT STATEMENTS )
GO TO 160
C 7. RUN SECTION
300 IF(LEVEL-2) 180,301,301
301 LEVEL=3
305 NH=0
NOUT=0
DO 306 I=1,4
306 NPR(I,2)=0
CALL INT(IFORM)
WRITE(NDEV2,311)
311 FORMAT(///22H ** RUN FINISHED **////)
ENDFILE NDEV2
GO TO 100
END
C P.I. COOPER MECH. ENG. JOOB NO. 010 27-4-67
C YDASH 4
SUBROUTINE YDASH(Y,X,INTJ)
COMMON IZ(7),MM,NEQ,IX(2),IOU
COMMON DUM(62),N(5,4),A(80)
COMMON DUMI(1050),V(1100),M(4000)
COMMON D(4,50)
DIMENSION Y(100),X(100)
DO 50 I=1,NEQ
50 V(M(I))=Y(I)
59 IE=100
60 IS=IE
DO 70 I=IS+1,IS+100
IF(M(I)) 70,75,70
70 CONTINUE
75 IE=I
IR=IE-IS-3
DO 80 I=1,IR
80 A(I) = V(M(IS+2+I))
GO TO(81,82,83,84,85 ),M(IS+1)
81 GO TO(110,120,130,140,150,160),M(IS+2)
82 GO TO(210,220,230,240,250,260),M(IS+2)
83 GO TO (310,320,330,340,350,360),M(IS+2)
84 GO TO (420,410,440,430,450,460),M(IS+2)
85 GO TO(510,520,530,540,550,560),M(IS+2)
110 A(1)=SQRT(A(2))
GO TO 700
120 A(1)=EXP(A(2))
GO TO 700
130 A(1)=ALOG(A(2))
GO TO 700
140 A(1)=ATAN(A(2))
GO TO 700
150 A(1)=ABS(A(2))
GO TO 700
160 A(1)=A(2)**A(3)
GO TO 700
210 A(1) = A(2)
DO 215 I=3,IR
215 A(1) = A(1)*A(I)
GO TO 700
220 A(1) = A(2)/A(3)
GO TO 700
230 A(1) = A(2)
DO 235 I=3,IR
235 A(1) = A(1) + A(I)
GO TO 700
240 A(1)= -A(2)
IF(IR-2) 700,700,251
250 A(1) = A(2)
251 DO 255 I=3,IR
255 A(1) = A(1) - A(I)
GO TO 700
260 A(1)=(A(2)*(A(3)-A(4))/A(5)+A(6)*(A(7)-A(8))/A(9)-A(10)*(A(11)-A(1
12))/A(13)-A(14)*(A(15)-A(16))/A(17))/A(18)
GO TO 700
310 IF(A(2)) 312,315,315
312 A(1) =-1.0
GO TO 700
315 A(1) = 1.0
GO TO 700
320 A(1) = A(2)
IF(A(4) - A(2)) 325,700,321
321 A(1) = A(4)
GO TO 700
325 IF(A(2) - A(3)) 700,700,326
326 A(1) = A(3)
GO TO 700
330 A(1) = 0.0
IF(A(2)-A(3)) 335,700,332
332 A(1) = A(2)-A(3)
GO TO 700
335 IF(A(2)-A(4)) 336,700,700
336 A(1) = A(2) - A(4)
GO TO 700
340 IF(A(4)) 345,341,341
341 A(1)= A(2)
GO TO 700
345 A(1) = A(3)
GO TO 700
C RANDOM FUNCTION GENERATOR
350 IF(V(10))533,532,533
532 X03=0.
X04=0.
IU=123456789.*A(2)
A(1)=0.
A(2)=0.
533 IF(INTJ-2)534,535,534
534 IF(INTJ-4)700,535,700
535 CALL RNG(IU,X03)
X04=(X03+ 37.4*A(1)- 16.1*A(2))/22.3
V(M(IS+4))=A(1)
A(1)=X04
GO TO 700
C
360 IF(ABS(A(2))-A(3))541,541,542
541 A(1)=0.
GO TO 700
542 IF(A(2)-A(4))544,543,543
543 A(1)=A(5)
GO TO 700
544 IF(A(2)+A(4))545,545,546
545 A(1)=-A(5)
GO TO 700
546 IF(A(1))548,547,549
547 A(1)=0.
GO TO 700
548 A(1)=-A(5)
GO TO 700
549 A(1)=A(5)
GO TO 700
410 A(1)=SIN(A(2))
GO TO 700
420 A(1)=COS(A(2))
GO TO 700
430 A(1) = A(2)
IF(A(3)) 431,700,700
431 A(1) = 0.0
GO TO 700
440 A(1) = 0.0
IF(A(3)) 700,441,441
441 A(1) = A(2)
GO TO 700
450 GO TO 700
460 GO TO 700
510 N1=N(M(IS+5),2)
N2=N(M(IS+5),3)
IF(A(2) - D(1,N1)) 511,512,512
511 A(1) = D(4,N2)
GO TO 700
512 IF(D(1,N2) - A(2)) 513,513,515
513 A(1) = D(2,N2)
GO TO 700
515 DO 519 I=N1,N2-1
IF(D(1,I+1)-A(2)) 519,516,516
516 A(1) = D(3,I)*A(2) + D(4,I)
GO TO 700
519 CONTINUE
520 GO TO 700
530 GO TO 700
540 GO TO 700
550 GO TO 700
560 GO TO 700
700 V(M(IS+3)) = A(1)
IF(IE - MM) 60,710,710
710 DO 711 I=1,NEQ
711 X(I)=V(M(3900+I))
RETURN
END
SUBROUTINE READ
C READS A LINE OR CARD , INTERPRETS ,
C PACKS IT CORRECTLY INTO SYMB ARRAY .
COMMON NDEV1,NDEV2,LW
COMMON IB,N,IZ(7)
COMMON DUM(56),ARITH(6),Z9(20)
COMMON A(80),B(50)
CONST=5HCONST
TITLE = 5HTITLE
COMMA=5H,
BLANK=5H
EQUAL=5H=
IF(NDEV1-5) 9,5,9
5 IF(N-1) 7,6,7
6 LW=15
GO TO 10
7 LW=30
GO TO 10
9 LW=80
10 READ(NDEV1,11)(A(I),I=1,LW)
11 FORMAT( 80A1)
15 WRITE(NDEV2,12)(A(I),I=1,LW)
12 FORMAT(15X,105A1)
20 IF(A(1) - BLANK) 10,80,10
80 DO 81 I=1,30
81 B(I)=BLANK
IAT=1
IT =1
IA=0
IB=0
90 IA=IA+1
91 IB=IB+1
ITW=0
100 IF(A(IA)-BLANK) 101,130,101
101 IF(A(IA)-EQUAL) 102,90,102
102 IF(A(IA)-COMMA) 110,103,110
103 IF(N-1) 960,506,106
506 N=0
IB=2
GO TO 90
106 IF(B(1) - TITLE) 90,107,90
107 IT=IT+2
IB=IT
GO TO 90
110 IF(N-2) 120,111,120
111 DO 119 J=1,6
IF(A(IA)-ARITH(J)) 119,200,119
119 CONTINUE
120 ITW=ITW+1
IF(ITW-5) 125,125,300
125 CALL INTO(B(IB),ITW,A(IA))
IAR=0
130 IA=IA+1
IF(IA-LW) 100,100,950
200 IF(IAR) 205,201,205
201 IB=IB+1
205 CALL INTO(B(IB),1,A(IA))
IAR=1
GO TO 90
300 IF(N-2) 91,301,91
301 IF(B(IB)-CONST) 900,91,900
900 WRITE(NDEV2,901)
901 FORMAT(5X,28H * VARIABLE NAME TOO LONG )
IB=-IB
RETURN
950 IF(B(IB) - BLANK) 960,955,960
955 IB=IB-1
960 RETURN
END
SUBROUTINE WRITE(IFORM)
C WRITES RUN OUTPUT .
COMMON ND,NDEV2,IZ(7)
COMMON NH,NOUT,IOU
COMMON N(4,8),TTL(2,12),DUM(6)
COMMON TEMP(120),DUM1(1030),VAL(1100)
DIMENSION DATA(120)
IF(IFORM) 99,9008,99
99 IF(NH) 200,100,200
100 WRITE(NDEV2,101)
101 FORMAT(////21H ** PROGRAM RUN ** // )
NW=12
IF(NDEV2-5) 110,105,110
105 NW=6
110 DO 120 I=1,2
WRITE(NDEV2,115)(TTL(I,J),J=1,NW)
115 FORMAT(A10,A5,5(A15,A5)//)
120 CONTINUE
200 WRITE(NDEV2,201)
201 FORMAT (1H )
DO 230 J=1,4
IF(N(J,2)-NH) 210,210,260
210 K=8
211 IF(N(J,K)) 220,212,220
212 K=K-1
IF(K-2) 260,260,211
220 WRITE(NDEV2,221)(VAL(N(J,IN)),IN=3,K)
221 FORMAT(1PE15.4,5E20.4)
230 N(J,2)=N(J,2)+N(J,1)
260 NOUT=N(1,2)
IF(VAL(8)) 265,270,270
265 IOU=-1
RETURN
270 IOU=0
RETURN
9008 IF(NH) 300,9009,300
9009 TYPE 9006
ACCEPT 9007,NBLOC
9006 FORMAT (' TYPE NUMBER OF WORDS PER BLOCK'/)
9007 FORMAT (I)
300 IF(NH) 302,301,302
301 NDATA=0
302 DO 350 J=1,4
IF(N(J,2)-NH)310,310,260
310 K=8
311 IF(N(J,K))320,312,320
312 K=K-1
IF(K-2) 260,260,311
320 DO 330 L=1,K-2
330 DATA(NDATA+L)=VAL(N(J,L+2))
NDATA=NDATA+K-2
IF(NDATA-NBLOC) 350,340,340
340 WRITE(NDEV2)(DATA(IN),IN=1,NBLOC)
NDATA=0
350 N(J,2)=N(J,2)+N(J,1)
GO TO 260
RETURN
END
C INT 4
C FOURTH-ORDER RUNGE-KUTTA INTEGRATION ROUTINE .
SUBROUTINE INT(IFORM)
COMMON IZ(8)
COMMON NEQ,NH,NOUT,IOU
COMMON DUM(1212),VAL(1100)
DIMENSION A(4),B(4),C(4)
DIMENSION Y(100),Q(100),W(100)
IF( NH ) 200,100,200
100 A(1)=0.5
C(1)=0.5
C(4)=0.5
A(3)=1.70710678
C(3)=1.70710678
A(2)= .29289322
C(2)= 0.29289322
A(4)=1.0/6.0
B(1)=2.0
B(4)=2.0
B(2)=1.0
B(3)=1.0
H=VAL(7)
IOU=0
NH =0
DO 110 I =1,NEQ
Q(I)=0.0
110 Y(I)=VAL(1000+I)
C CODING
200 IF(NH - NOUT ) 210,205,205
205 IOU=1
210 DO 230 J=1,4
CALL YDASH(Y,W,J)
IF(IOU) 250,220,215
215 CALL WRITE(IFORM)
220 DO 225 I=1,NEQ
D=A(J)*(W(I) - B(J)*Q(I))
Y(I) = Y(I) + H*D
225 Q(I) = Q(I) + 3.0*D - C(J)*W(I)
230 CONTINUE
NH=NH+1
GO TO 200
250 RETURN
END
FUNCTION JPAR(A)
C FINDS OR CREATES A IN SYMB ARRAY .
COMMON IZ(5),MPAR,IX(6)
COMMON DUM(212),PAR(1000)
DO 10 I=1,1000
IF(PAR(I)-A) 10,20,10
10 CONTINUE
MPAR=MPAR+1
PAR(MPAR)=A
JPAR=MPAR
RETURN
20 JPAR=I
RETURN
END
FUNCTION DPAR(J)
C CREATES A DUMMY LOGICAL NAME .
COMMON IZ(11),N
DIMENSION D(10)
IF(J) 200,100,200
100 D(1) = 1H0
D(2) = 1H1
D(3) = 1H2
D(4) = 1H3
D(5) = 1H4
D(6) = 1H5
D(7) = 1H6
D(8) = 1H7
D(9) = 1H8
D(10)=1H9
M1=0
M2=0
M3=0
CHAR=4H)000
N=1
200 M1=M1+1
IF(M1-10) 260,210,260
210 M1=0
M2=M2+1
IF(M2-10) 250,220,250
220 M2=0
M3=M3+1
CALL INTO(CHAR,2,D(M3+1))
250 CALL INTO(CHAR,3,D(M2+1))
260 CALL INTO(CHAR,4,D(M1+1))
DPAR=CHAR
RETURN
END
FUNCTION NO(A)
C RECOGNISES AN INTEGER IN 'A' FORMAT
COMMON NDEV1,NDEV2,LW,IZ(9)
COMMON DUM(82),B(100)
DIMENSION DIGIT(10)
BLANK = 5H
BL=5H)
NO = 0
ND = 1
DIGIT(1)=1H0
DIGIT(2)=1H1
DIGIT(3)=1H2
DIGIT(4)=1H3
DIGIT(5)=1H4
DIGIT(6)=1H5
DIGIT(7)=1H6
DIGIT(8)=1H7
DIGIT(9)=1H8
DIGIT(10)=1H9
10 DO 30 I = 1,LW
IF(B(LW+1-I) - BLANK) 11,30,11
11 IF(B(LW+1-I) - BL) 15,30,15
15 DO 20 J=1,10
IF(B(LW+1-I)- DIGIT(J)) 20,25,20
20 CONTINUE
IF(ND-1) 90,21,90
21 NO=-1
GO TO 90
25 NO = (J-1)*ND + NO
ND = 10*ND
30 CONTINUE
90 RETURN
END