Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/bmd/bmdx93.for
There is 1 other file named bmdx93.for in the archive. Click here to see a list.
00100 C COMMON/PTABLE/NPCNT
00200 COMMON/OVERLY/NNNN
00300 COMMON/BCDIN/INTAPE,KTYPE,FORMAT,LNTAPE,LUNIT,NUNIT,REWIND,XHEIT,
00400 1 NAMP
00500 COMMON/CALB/CAL(32)
00600 DOUBLE PRECISION NAMCHN
00700 COMMON/CHANEL/NAMCHN(32),NVU,NCODE,NPULS,NNV(32),IPRNT
00800 COMMON/BRI/FILE(2),LONG,BCODE,HCODE,LENGTH,BPULSE,HPULSE,EXPNO,
00900 1PSTART,PEND,TSTART,TEND,IDAY,IHR,IMIN,ISEC,SAMPRT,ISKIP
01000 COMMON/XDATA/ICODE,IPOINT
01100 COMMON/TABLE/ISCANC,INCODE,ISCANP,INPULS,FILID(2),NREC
01200 COMMON/PTABLE/NPCNT,NPREC,NPLOC
01300 LOGICAL IPRNT
01400 INTEGER BCODE,HCODE,BPULSE,HPULSE,EXPNO,PSTART,PEND
01500 INTEGER BCODEA,HCODEA,BPULSA,HPULSA
01600 C INITIALIZATION
01700 DIMENSION Q(10000),NAMPRO(9),A(19),NREGM(9),NREGV(9),TEMP(16),
01800 1 ITEMP(16),F(9),TITLE(18,9),FORMAT(18,9),LUNIT(3,9),XAMFRQ(9)
01900 DIMENSION NPLOC(400,2)
02000 EQUIVALENCE (RBLANK,BLANK),(NBLANK,BLANK)
02100 DATA KDIV/-1/
02200 DATA NTOT/10000/
02300 REAL LABL,NAMCH,NAME
02400 INTEGER BRI,BCD,BIN
02500 DATA NAMPRO/9*' '/,PROB/'PROB'/,NAMCH/'NAMC'/,TITL/'TITL'/,
02600 1 PARAM/'PARA'/,POSITN/'POSI'/,FINISH/'FINI'/,BRI/'BRI '/
02700 DATA NPROB/0/,JNAMCH/0/,NBLANK/' '/,NREG/1/
02800 DOUBLE PRECISION NULL,NCADE,NSTIM,RBLANK
02900 DATA NULL/'NULL '/,NCADE/'CODE '/,NSTIM/'STIM '/,
03000 1RBLANK/' '/
03100 DATA NPULSA,NPULSB/0,0/
03200 DATA NAME/'NAME'/,FORM/'FORM'/
03300 DATA IDP/1/,IDG/5/,INPTYP/'BRI '/,TPULS/1.0/,NOPULS/1/,NALYS/1/,
03400 1 BLANK/' '/
03500 SAMPRT=256.
03600 CALL USAGEB('BMDX93')
03700 DATA IO/-1/,IOB/-1/,NOVFMT/1/
03800 DATA FMAX/9999./,XCODE/ 0.0/,XPULSE/ 0.0/
03900 DATA CALIB/'CALI'/,BCD/'BCD '/,BIN/'BIN '/,YES/'YES '/
04000 FILE(1)=BLANK
04100 FILE(2)=BLANK
04200 ISKIP=2
04300 LABL=NBLANK
04400 NNNN=0
04500 INVALD=0
04600 NVU=0
04700 NCODE=0
04800 KTYPE=0
04900 HPULSE=0
05000 INTAPE=5
05100 LONG=30
05200 LENGT1=1
05300 LENGT2=2
05400 BPULSE=0
05500 DO 8 J=1,9
05600 XAMFRQ(J)=0.
05700 DO 8 I=1,3
05800 8 LUNIT(I,J)=0
05900 DO 9 I=1,32
06000 9 CAL(I)=1.0
06100 BCODE=0
06200 NUNIT=0
06300 HCODE=100
06400 NPCNT=0
06500 INTAPE=5
06600 C NNV(I)=1 IF CHAN IS USED, =0 IF NOT USED
06700 C NVU NO OF CHANNELS USED
06800 C NV NO OF CHANNELS ON TAPE
06900 C NAMPRO NAMES OF PROBLEMS
07000 C PROB ALPHA PROB
07100 C NAMCH ALPHA NAME
07200 C TITLE ALPHA TITL
07300 C FORMAT ARRAY WHICH CONTAINS VARIABLE INPUT FORMAT
07400 C PARAM ALPHA PARA
07500 C REWIND ''NO''=INPUT TAPE IS NOT TO BE REWOUND FOR THIS PROBLEM
07600 C POSITN ALPHA POSI
07700 C NPROB NUMBER OF PROBLEMS BEING EXECUTED
07800 C JNAMCH ZERO IF NO NAMCH CARD EXISTS, ONE OTHERWISE
07900 C A STORAGE AREA TO SAVE PROBLEM CARDS
08000 C FINISH ALPHA FINI
08100 C NBLANK ALPHA BLANK
08200 C NAMP NAME OF PROBLEM BEING READ IN
08300 C LUNIT ARRAY WHICH KEEPS TRACK OF SCAN POSITIONING AND NO. OF PULSES
08400 C PROBLM
08500 C NUNIT COUNTER FOR THE NUMBER OF DIFFERENT UNITS USED.
08600 C IDP DECIMATION FOR PRINTING
08700 C IDG DECIMATION FOR GRAPH
08800 C INTAPE LOGICAL INPUT TAPE IF NOT BRI INPUT
08900 C INPTYP TYPE OF INPUT
09000 C LNTAPE CONTAINS LAST INPUT UNIT READ IN OFF PARAM CARD.
09100 C TPULSE TIME FROM PULSE TO END OF ANALYSIS(TIME BASE)
09200 C NOPULS NUMBER OF PULSE CHANNELS
09300 C IPULSA FIRST PULSE CHANNEL
09400 C IPULSB SECOND PULSE CHANNEL
09500 C NALYS TYPE OF ANALYSIS, 1 IF SINGLE CLICK, 2 IF PAIRED CLICK
09600 C SAMPRT SAMPLING RATE
09700 C NVUA NUMBER OF GOOD CHANNELS
09800 C NVA TOTAL NUMBER OF CHANNELS
09900 C NDEL 1 IF END OF PROBLEM, 0 IF OTHERWISE
10000 C JANAL PROBLEM CURRENTLY BEING ANALYSED
10100 C NREG NEXT REGION IN Q TO BE USED
10200 C NREGM WHERE THE MEANS BEGIN FOR EACH PROBLEM
10300 C NREGV WHERE THE VARIANCES BEGIN FOR EACH PROBLEM
10400 C TEMP PARAMETERS FOR POSIT
10500 C ITEMP PARAMETERS FOR POSIT
10600 C IERROR ERROR RETURN FROM POSIT
10700 C NSCAN NUMBER OF SCANS IN TIME BASE
10800 C MPULSE 0 TO ANALYSE ON FIRST CHANNEL,1 TO ANALYSE ON SECOND CHANNEL
10900 C NTEMPM INDICES FOR STORING DATA
11000 C F NUMBER OF POINTS OR OBSERVATIONS(PULSES) IN SUMMATION
11100 C F NUMBER OF POINTS IN A SUMMATION
11200 C KTYPE 0=BRI DIGITIZED INPUT, 1=BCD INPUT, 2=BINARY INPUT
11300 C NOVFMT NUMBER OF INPUT VARIABLE FORMAT CARDS
11400 C IPRNT .TRUE.=STANDARD POSITIONING PRINTOUT,.FALSE.=DEBUG PRINTOUT
11500 C GENERAL READ STATEMENT
11600 10 IF(LABL.EQ.FINISH)GO TO 80
11700 READ (5,1010,END=300) LABL,A
11800 1010 FORMAT (20A4)
11900 1013 REWIND 1
12000 WRITE (1,1010) LABL,A
12100 REWIND 1
12200 C CALL USEBUF
12300 IF(LABL.EQ. FINISH) GO TO 80
12400 C IF (LABL.EQ.NAMCH) GO TO 60
12500 IF(LABL.EQ. PROB ) GO TO 20
12600 IF (INVALD .EQ.1) GO TO 10
12700 IF (NPROB.EQ.0) WRITE (6,1015) LABL,A
12800 1015 FORMAT (' FIRST PROBLEM, A CARD OTHER THAN A PROBLEM CARD=',20A4)
12900 IF (LABL.EQ.NAMCH.OR.LABL.EQ.NAME) GO TO 60
13000 IF(LABL.EQ.TITL)GO TO 70
13100 IF(LABL.EQ. PARAM ) GO TO 30
13200 IF(LABL.EQ. POSITN) GO TO 30
13300 IF (LABL.EQ.FORM) GO TO 95
13400 IF(LABL.EQ.CALIB)GO TO 85
13500 C IF LABEL DOES NOT MATCH,WE GO TO NEXT PROBLEM
13600 WRITE (6,1011) LABL,A
13700 1011 FORMAT (' THE FOLLOWING CARD WAS IMPROPERLY PUNCHED'//1X,20A4/
13800 1 '0THE NEXT CARDS LISTED WERE NOT EXECUTED'/'0WE WILL CONTINUE AT
13900 2 THE NEXT PROBLEM')
14000 INVALD =1
14100 C NPROB=0
14200 C DO 15 I=1,9
14300 C 15 NAMPRO(I)=NBLANK
14400 C READ (5,1010) LABL,A
14500 GO TO 10
14600 20 NPROB=NPROB+1
14700 INVALD =0
14800 C READ PROBLEM CARD
14900 READ (1,1020,END=310) LABL,NAMPRO(NPROB),SAMPRA,NVUA,NVA,TPULSA,
15000 1 NOPULA,IPULAA,IPULBA,NALYSA,IDPA,IDGA,INPTYA,MAXF,IOA,IOBA
15100 2,KDIVA,OTRACE
15200 1020 FORMAT (2A4,F5.0,2I2,F5.0,6I2,A3,I5,3I2,A3)
15300 IF(MAXF.GT.0)FMAX=MAXF-.5
15400 XAMFRQ(NPROB)=FMAX
15500 IF (NPROB.NE.1) GO TO 2020
15600 LENGTH=LENGT1
15700 IF (INPTYA.EQ.NBLANK.OR.INPTYA.EQ.INPTYP) LENGTH=LENGT2
15800 2020 IF (KDIVA.NE.0) KDIV=KDIVA
15900 IF(SAMPRA.GT.0)SAMPRT=SAMPRA
16000 IF(NVUA.GT.0)NVU=NVUA
16100 IF(NVA.GT.0)NV=NVA
16200 IF(TPULSA.GT.0)TPULS=TPULSA
16300 IF(NOPULA.GT.0)NOPULS=NOPULA
16400 IPRNT=.FALSE.
16500 IF (OTRACE.EQ.YES) IPRNT=.TRUE.
16600 IF (IPULAA.GT.0)NPULSA=IPULAA
16700 IF(IPULBA.GT.0)NPULSB=IPULBA
16800 IF (IOA.NE.0) IO=IOA
16900 IF (IOBA.NE.0) IOB=IOBA
17000 IF(NALYSA.GT.0)NALYS=NALYSA
17100 1022 FORMAT (' WARNING--COLS. 58-62 ON PROB CARD ARE ZERO AND INPUT DAT
17200 1A FROM CARDS, THIS MAY CAUSE TROUBLE'/' WILL READ UNTIL END OF FIL
17300 2E')
17400 IF(IDPA.GT.0)IDP=IDPA
17500 IF(IDGA.GT.0)IDG=IDGA
17600 IF (INPTYA.NE.NBLANK) INPTYP=INPTYA
17700 KTYPE=0
17800 IF (INPTYP.EQ.BCD) KTYPE=1
17900 IF (INPTYP.EQ.BIN) KTYPE=2
18000 IF(NOPULS.EQ.2.AND.NPULSB.LE.0)GO TO 90
18100 IF(NALYS.EQ.2.AND.NOPULS.NE.2)GO TO 90
18200 IA=NREG
18300 NSCAN=TPULS*SAMPRT
18400 NREGM(NPROB)=NREG
18500 NREGV(NPROB)=NREG+NSCAN*NVU
18600 NREG=NREG+2*NSCAN*NVU
18700 IF(NALYS.EQ.2.AND.NREG+NSCAN*NVU.GT.NTOT)GO TO 22
18800 IF(NREG.LT.NTOT)GO TO 123
18900 22 CONTINUE
19000 WRITE(6,1023)NAMPRO(NPROB),NREG,NTOT
19100 1023 FORMAT('1THE SPACE REQUIRED FOR PROBLEM',A6,' IS',I7,' LOCATIONS
19200 1, BUT ONLY',I7, ' LOCATIONS ARE AVAILABLE'/'0REDUCE PROBLEM SIZE
19300 2 '/'0THIS PROBLEM WILL BE SKIPPED'/)
19400 NAMPRO(NPROB)=NBLANK
19500 NPROB=NPROB-1
19600 NREG=IA
19700 123 CONTINUE
19800 F(NPROB)=0.0
19900 DO 23 I=IA,NREG
20000 23 Q(I)=0.0
20100 DO 24 I=1,18
20200 24 TITLE(I,NPROB)=BLANK
20300 GO TO 10
20400 30 CONTINUE
20500 CALF=1.0
20600 IF (NCODE.EQ.0) GO TO 87
20700 IF (CAL(NCODE).EQ.0.)CAL(NCODE)=1.0
20800 CALF=CAL(NCODE)
20900 87 DO 86 I=1,16
21000 IF (CAL(I).EQ.0.) CAL(I)=CALF
21100 86 CONTINUE
21200 C READ PARAM OR POSITION CARD
21300 READ (1,1030)LABL,LONGA,BCODEA,XCODEA,LENGTA,BPULSA,XPULSA,EXPNO,
21400 1PSTART,PEND,TSTART,TEND,IDAY,IHR,IMIN,ISEC,NAMP,NDEL,INTAPA,NVFMTA
21500 2,REWIND,NCSTOP
21600 1030 FORMAT(A4,2X,I3,I5,F5.0,2I3,F5.0,3I3,2F7.0,I3,3I2,A4,I1,2I2,A3,I5)
21700 LBEGIN=PSTART
21800 IF (KTYPE.NE.0) GO TO 430
21900 HCODEA=XCODEA
22000 HPULSA=XPULSA
22100 430 IF (NVFMTA.GT.0) NOVFMT=NVFMTA
22200 LNTAPE=INTAPE
22300 IF (INTAPA.GT.0) INTAPE=INTAPA
22400 IF (INTAPE.EQ.5.AND.NCSTOP.EQ.0.AND.KTYPE.EQ.1) WRITE (6,1022)
22500 AMAXF=PEND-PSTART+1.
22600 IF (MAXF.EQ.0) FMAX=AMAXF-0.5
22700 IF(NPROB.EQ.0)GO TO 33
22800 DO 32 I=1,NPROB
22900 IF(NAMP.NE.NAMPRO(I)) GO TO 32
23000 JANAL=I
23100 GO TO 31
23200 32 CONTINUE
23300 33 WRITE(6,1033)NAMP
23400 1033 FORMAT('1PARAM CARD FOUND WITH FOLLOWING NAME' A6,/
23500 1 '0THE CARD WILL BE IGNORED')
23600 GO TO 10
23700 31 CONTINUE
23800 IF (XAMFRQ(JANAL).GT.FMAX) FMAX=XAMFRQ(JANAL)
23900 IF (IPRNT) WRITE (6,2134)
24000 2134 FORMAT (1H ,10(1H*),104HNOTE--COMPLETE POSITIONING AND TRACING PRI
24100 1NTOUT REQUESTED (USE THIS SPARINGLY TO AVOID EXCESSIVE OUTPUT),
24200 2 10(1H*))
24300 IF(LONGA.NE.0)LONG=LONGA
24400 IF(BCODEA.NE.0)BCODE=BCODEA
24500 IF (XCODEA.NE.0) XCODE=XCODEA
24600 IF(HCODEA.NE.0)HCODE=HCODEA
24700 IF (XPULSA.NE.0) XPULSE=XPULSA
24800 IF(LENGTA.NE.0)LENGTH=LENGTA
24900 IF(BPULSA.NE.0)BPULSE=BPULSA
25000 IF(HPULSA.NE.0)HPULSE=HPULSA
25100 IF (KTYPE.EQ.0) WRITE (6,1031) LONG,BCODE,HCODE,LENGTH,BPULSE,
25200 1 HPULSE,EXPNO,PSTART,PEND,TSTART,TEND,IDAY,IHR,IMIN,ISEC,NAMP,NDEL
25300 1031 FORMAT
25400 X(11X,'LONG = ',I3,' BCODE = ',I5,' HCODE = ',I5,' LENGTH = ',I3
25500 X/11X,'BPULSE = ',I3,' HPULSE = ',I5,' EXPNO = ',I3
25600 X/11X,'PSTART = ',I3,' PEND = ',I3,' TSTART = ',F7.3,' TEND = '
25700 X,F7.3/11X,'IDAY = ',I3,' IHR = ',I2,' IMIN = ',I2,' ISEC = ' ,
25800 XI2,' PROBLEM 'A4,' END 'I2)
25900 NCNT=0
26000 ISCANA=0
26100 NSTOP=TEND*SAMPRT
26200 NPULS=NPULSA
26300 XHEIT=XCODE
26400 IF(FMAX.LT.F(JANAL))GO TO 43
26500 C IF(PSTART.GT.0.AND.TSTART.EQ.0)PSTART=1
26600 IF (KTYPE.NE.0) GO TO 35
26700 IF(PSTART.GT.0.AND.TSTART.EQ.0.)GO TO 35
26800 IF (KTYPE.EQ.0) CALL PICKLS
26900 IF (IERROR.GT.0)STOP
27000 133 ISCANA=NNNN
27100 TSTART=0.0
27200 PSTART=NPCNT+1
27300 35 CONTINUE
27400 IF (LBEGIN.EQ.PSTART) GO TO 2435
27500 LNTAPE=INTAPE
27600 IF ((NNNN+1).GT.NCSTOP.AND.INTAPE.EQ.5.AND.NCSTOP.GT.0) GO TO 43
27700 IF (NALYS.EQ.1.AND.PEND.GT.0.AND.NPCNT.GE.PEND) GO TO 43
27800 REWIND=0.0
27900 2435 IREG=NREG
28000 IF (KTYPE.EQ.0) CALL PICKLS
28100 IF (KTYPE.NE.0) CALL FPULSE (NV,PSTART,TSTART,SAMPRT,NPULS,LENGTH,
28200 1 IPRNT,NERROR)
28300 C IF (IERROR.GT.0) STOP
28400 IF (NERROR) 43,236,93
28500 236 IF (LABL.EQ.POSITN) GO TO 10
28600 IF (NPCNT.EQ.LBEGIN) WRITE (6,2236) LBEGIN
28700 2236 FORMAT (1H ,10(1H*),'BEGINNING ANALYSIS ON PULSE NUMBER',I3,10(1H*
28800 1))
28900 IF (NVU.EQ.0)GO TO 91
29000 C TSTART=0
29100 IF (ISCANA.EQ.0) ISCANA=NNNN
29200 NSTOPB=NSTOP-NNNN+ISCANA
29300 IF (TEND.GT.0.0.AND.NSTOPB.LE.0.AND.KTYPE.EQ.0) GO TO 43
29400 IF ((NNNN+NSCAN).GT.NCSTOP.AND.NCSTOP.GT.0) GO TO 43
29500 NTEMPM=NREGM(JANAL)
29600 NTEMPV=NREGV(JANAL)
29700 F(JANAL)=F(JANAL)+1.0
29800 DO 140 II=1,NSCAN
29900 GO TO (237,238),KTYPE
30000 CALL PICKLS
30100 IF(IFSTOP.GT.0)GO TO 42
30200 GO TO 250
30300 237 READ (INTAPE,FORMAT,END=42) (TEMP(I),I=1,NV)
30400 IF(TEMP(1).EQ.-1.)GO TO 42
30500 NNNN=NNNN+1
30600 GO TO 240
30700 238 READ (INTAPE,END=42) (TEMP(I),I=1,NV)
30800 NNNN=NNNN+1
30900 240 I=1
31000 DO 245 K=1,NV
31100 IF (NNV(K).NE.1) GO TO 245
31200 TEMP(I)=TEMP(K)
31300 I=I+1
31400 245 CONTINUE
31500 C IF (NVU.NE.I-1) PRINT 246, I,NVU
31600 C 246 FORMAT (' LOGICA MISTAKE IN CALUULATING NO. OF VARS. USED, NVU=',
31700 C 1 I5,' I=',I5)
31800 250 IF (NALYS.EQ.1) GO TO 37
31900 IF (NPULSB.EQ.NPULS) GO TO 36
32000 DO 134 I=1,NVU
32100 Q(IREG)=TEMP(I)
32200 134 IREG=IREG+1
32300 GO TO 140
32400 36 DO 135 I=1,NVU
32500 TEMP(I)=TEMP(I)-Q(IREG)
32600 135 IREG=IREG+1
32700 37 DO 39 J=1,NVU
32800 D=TEMP(J) - Q(NTEMPM)
32900 Q(NTEMPM)= Q (NTEMPM)+ D/F(JANAL)
33000 Q(NTEMPV)= Q (NTEMPV)+ D*(TEMP(J)-Q(NTEMPM))
33100 NTEMPM=NTEMPM+1
33200 NTEMPV=NTEMPV+1
33300 39 CONTINUE
33400 140 CONTINUE
33500 IF (NOPULS.EQ.1) GO TO 40
33600 IF(NPULSA.EQ.NPULS) GO TO 38
33700 NPULS=NPULSA
33800 XHEIT=XCODE
33900 GO TO 40
34000 38 NPULS=NPULSB
34100 XHEIT=XPULSE
34200 IF(NALYS.EQ.2)F(JANAL)=F(JANAL)-1.0
34300 40 CONTINUE
34400 150 PSTART=PSTART+1
34500 IF(PSTART.GT.NPCNT)GO TO 160
34600 IF(NREC.GT.NPLOC(PSTART,1))GO TO 150
34700 IF(IPOINT.GT.NPLOC(PSTART,2))GO TO 150
34800 160 CONTINUE
34900 IF(FMAX.LT.F(JANAL))GO TO 43
35000 C IF (PEND.GT.0.AND.PEND.GE.NPCNT) GO TO 43
35100 GO TO 35
35200 42 F(JANAL)=F(JANAL)-1.0
35300 43 IF (INTAPE.NE.5.OR.NNNN.GE.NCSTOP) GO TO 44
35400 NX=NNNN+1
35500 IF(NSTOP.NE.0)GO TO 2042
35600 2046 READ(5,FORMAT,ERR=44,END=44)
35700 GO TO 2046
35800 2042 DO 2044 I=NX,NCSTOP
35900 2044 READ (5,FORMAT)
36000 44 IF (NDEL.EQ.0) GO TO 10
36100 WRITE (6,2043) PEND
36200 2043 FORMAT (1H ,10(1H*),'END ANALYSIS BEFORE PULSE NUMBER',I3,10(1H*))
36300 WRITE (6,999)
36400 999 FORMAT('1',20X,'BMDX93..........TIME-LOCKED AVERAGING PROGRAM'//
36500 1 25X,'(WITH INPUT TO BMD05D)'//
36600 2 25X,'HEALTH SCIENCES CONPUTING FACILITY'//
36700 325X,'REVISED JUNE 24, 1968')
36800 WRITE (6,1032) (TITLE(I,JANAL),I=1,18)
36900 1032 FORMAT (/T10,'THE TITLE IS'/T20,18A4//)
37000 IF (MAXF.EQ.0) MAXF=FMAX+0.5
37100 WRITE(6,998)(I,NAMCHN(I),CAL(I),I=1,NV)
37200 998 FORMAT('0',T10,'CHAN NO',T20,'NAME',T30,'CALIBRATION FACTOR'/
37300 1(T15,I2,T20,A8,T32,F7.2))
37400 WRITE(6,1034)NAMPRO(JANAL),SAMPRT,NV,NVU,TPULS,NOPULS,NPULSA,NPUL
37500 1SB,IO,IOB,NALYS,IDP,IDG,INPTYP,MAXF,KDIV
37600 1034 FORMAT(//
37700 1 T10,'NAME OF PROBLEM'T50,A4/T10,'SAMPLING RATE'T47,F7.2/ T1
37800 10,'NUMBER OF VARIABLES'T50,I4/T10,'NUMBER OF VARIABLES ANALYZED'T5
37900 A0
38000 2,I4/T10,'TIME BASE'T48,F6.3/T10,'NUMBER OF PULSE CHANNELS'T50,I4/T
38100 320,'VARIABLES'I4,' AND'I4/T10,'OUTPUT UNIT FOR 05D CARDS'T50,I4/T
38200 410,'OUTPUT UNIT FOR DATA'T50,I4/T10,'METHOD OF ANALYSIS'T50,I4/T10
38300 5,'DECIMATION FOR PRINTER'T50,I4/T10,'DECIMATION FOR PLOT'T50,I4/T1
38400 60,'TYPE OF INPUT',T51,A3/T10,'MAX. NUMBER OF CASES IN ANY AVERAGE'
38500 7,T49,I5/T10,'NO. OF GROUPS THE AVERAGES SPLIT INTO',T50,I4)
38600 IF (KTYPE.NE.0) WRITE (6,1133) INTAPE,NVFMTA
38700 1133 FORMAT (T10,'LOGICAL UNIT FOR INPUT DATA',T50,I4/T10,'NUMBER OF IN
38800 1PUT VARIABLE FORMAT CARDS',T50,I4)
38900 IF (KTYPE.NE.0.AND.INTAPE.EQ.5) WRITE (6,1134) NCSTOP
39000 1134 FORMAT (T10,'NUMBER OF CARDS INPUT THIS PROBLEM', T50,I4)
39100 CALL OUTPUT (Q(NREGM(JANAL)),Q(NREGV(JANAL)),NSCAN,NVU,IDP,IO,
39200 1 F(JANAL),NAMPRO(JANAL),IDG,SAMPRT,IOB,TITLE(1,JANAL),KDIV)
39300 C WE DELETE THE SPACE ASSIGNED TO THE PROBLEM
39400 NPROB=NPROB-1
39500 NREGD=2*(NREGV(JANAL)-NREGM(JANAL))
39600 NREG=NREG-NREGD
39700 IF (JANAL.GT.NPROB) GO TO 10
39800 IA=NREGM(JANAL)-1
39900 DO 45 I=1,NREGD
40000 45 Q(IA+I)=Q(I+IA+NREGD)
40100 DO 46 I=JANAL,NPROB
40200 F(I)=F(I+1)
40300 NAMPRO(I)=NAMPRO(I+1)
40400 NREGM(I)=NREGM(I+1)-NREGD
40500 46 NREGV(I)=NREGV(I+1)-NREGD
40600 DO 47 I=JANAL,NPROB
40700 DO 47 J=1,18
40800 47 TITLE(J,I)=TITLE(J,I+1)
40900 GO TO 10
41000 60 JNAMCH=1
41100 IF (LABL.EQ.NAME) GO TO 61
41200 C READ NAMCHN CARD
41300 READ (1,1060) (NAMCHN(I),I=1,NV)
41400 1060 FORMAT (6X,16A4)
41500 GO TO 1064
41600 61 READ (1,1062) (NAMCHN(I),I=1,NV)
41700 1062 FORMAT (6X,8A8)
41800 1064 DO 62 I=1,32
41900 62 NNV(I)=0
42000 NCODE=0
42100 J=0
42200 DO 63 I=1,NV
42300 NNV(I)=1
42400 J=J+1
42500 IF(NAMCHN(I).NE.RBLANK.AND.NAMCHN(I).NE.NULL.AND.NAMCHN(I).NE.
42600 1 NSTIM.AND.NAMCHN(I).NE.NCADE)GO TO 63
42700 J=J-1
42800 NNV(I)=0
42900 IF(NAMCHN(I).EQ.NCADE)NCODE=I
43000 63 CONTINUE
43100 NVU=MIN0(NVU,J)
43200 GO TO 10
43300 300 WRITE (6,301) LABL, A
43400 301 FORMAT (' END OF FILE ENCOUNTERED WHILE READING CONTROL CARDS, THE
43500 1 LAST CARD READ WAS'/1X,20A4)
43600 STOP
43700 70 CONTINUE
43800 C READ TITLE CARD
43900 READ (1,1070,END=310) LABL,NAMP,(A(I),I=1,18)
44000 1070 FORMAT (20A4)
44100 DO 72 I=1,NPROB
44200 IF(NAMP.NE.NAMPRO(I)) GO TO 72
44300 DO 71 J=1,18
44400 71 TITLE(J,I)=A(J)
44500 GO TO 10
44600 310 WRITE (6,311) LABL
44700 311 FORMAT (' END OF FILE ENCOUNTERED WHILE READING UNIT 1 FOR FORMAT
44800 1CONVERSION, LAST LABEL READ WAS',A5)
44900 STOP
45000 72 CONTINUE
45100 WRITE(6,1072) NAMP,A
45200 1072 FORMAT('1THE FOLLOWING TITLES CARD DID NOT CORRESPOND TO ANY
45300 1KNOWN PROBLEM'/'0NAME=',A6, ' TITLE IS',2X,18A4,/' THE CARD
45400 2WILL BE IGNORED')
45500 GO TO 10
45600 80 CONTINUE
45700 C IF FINISH CARD IS READ
45800 IF(NPROB.GT.0)GO TO 82
45900 IF(INPTYP.EQ.BRI) CALL PICKLS
46000 WRITE (6,1080)
46100 1080 FORMAT('1FINISH CARD READ,PROBLEM TERMINATED' /1X)
46200 WRITE (IO,1090)
46300 1090 FORMAT('FINISH',T80,'5')
46400 STOP
46500 82 JANAL=NPROB
46600 GO TO 44
46700 85 READ (1,1085) (CAL(I),I=1,NV)
46800 1085 FORMAT (6X,16F4.0)
46900 GO TO 10
47000 90 WRITE(6,1091)NAMPRO(NPROB)
47100 1091 FORMAT('1',10X,'THE NUMBER OF PULSE CHANNELS FOR PROBLEM' A6,
47200 1 ' IS INCORRECT'/20X,'THIS PROBLEM WILL BE SKIPPED')
47300 NPROB=NPROB -1
47400 GO TO10
47500 91 WRITE(6,1092)
47600 1092 FORMAT('1THE NUMBER OF CHANNELS TO BE ANALYSED IS ZERO,'/
47700 1 '0CHECK THAT A CORRECT NAMC CARD PRECEDES THE PARA CARD OR THAT
47800 1NUMBER OF CHANNELS TO BE ANALYSED WAS SPECIFIED ON PROB CARD'/
47900 2 '0THIS JOB IS TERMINATED')
48000 93 IF (INPTYP.EQ.BRI) CALL PICKLS
48100 STOP
48200 95 CONTINUE
48300 C READ VARIABLE FORMAT CARD(S)
48400 I=1
48500 98 READ (1,1070,END=310) LABL,(FORMAT(J,I),J=1,19)
48600 READ (5,1010,END=300) LABL,A
48700 IF (LABL.NE.FORM) GO TO 1013
48800 I=I+1
48900 GO TO 98
49000 END
49100 SUBROUTINE PICKLS
49200 WRITE(6,1)
49300 1 FORMAT(' THIS IS THE SUBROUTINE THAT WAS MISSING FROM THE ' /
49400 1'ORIGINAL LISTING. I THINK IT IS THE SAME AS THE SUBROUTINE '/
49500 2'POSIT FROM BMDX92,WHICH IS MERELY AN ERROR ROUTINE.')
49600 RETURN
49700 END
49800 SUBROUTINE OUTPUT (XMEAN,VAR,N,NVAR,IDP,IO,F,NAME,IDG,SAMPRT,IOB,
49900 1 TITLE,KDIV)
50000 DOUBLE PRECISION NAMCHN
50100 COMMON/CHANEL/NAMCHN(32),NVU,NCODE,NPULS,NNV(32)
50200 COMMON/CALB/CAL(32)
50300 DIMENSION TITLE(14)
50400 DIMENSION XMEAN(NVAR,N),VAR(NVAR,N),VAL(32),VALV(32),VALVA(32),
50500 1VALVB(32)
50600 DIMENSION XX(10)
50700 IF(IDP.EQ.0)IDP=1
50800 IF (IOB.LE.0) GO TO 2005
50900 WRITE (6,2010) IOB
51000 DO 2001 I=1,N
51100 DO 2002 K=1,NVAR
51200 2002 VAL(K)=SQRT(VAR(K,I))
51300 WRITE (IOB,2000) (XMEAN(J,I),VAL(J),J=1,NVAR)
51400 2000 FORMAT (30A4)
51500 2001 CONTINUE
51600 2005 CONTINUE
51700 DP=IDP
51800 SAMPRA=SAMPRT/DP
51900 2010 FORMAT ( //' REQUEST FOR OUTPUT OF MEANS AND STANDARD DEVIATIONS
52000 1 TO BE WRITTEN ON LOGICAL UNIT',I3/' THIS DATA IS WRITTEN AS MEAN
52100 2AND ST. DEV. FOR EACH CHANNEL ANALYZED FOR EACH SCAN, USING (20A4)
52200 3 FORMAT')
52300 IDIFF=(N+9)/10
52400 IF (N.LE.10*IDP) IDIFF=IDP
52500 DO 4 I=1,10
52600 4 XX(I)=(I-1)*IDIFF/SAMPRT
52700 LL=0
52800 DO 11 M=1,NVAR
52900 5 LL=LL+1
53000 IF(NNV (LL).EQ.0)GO TO 5
53100 WRITE(6,1000)NAME
53200 1000 FORMAT('1',T20,'PRINTOUT OF MEANS FOR PROBLEM'2X,A4)
53300 WRITE(6,1001)(TITLE(I),I=1,14)
53400 1001 FORMAT(T20,'TITLE---'20A4 )
53500 WRITE(6,1002)LL,NAMCHN(LL),F,IDP
53600 1002 FORMAT(T20,'VARIABLE',T49,I2,1X,A6,/,T20,'NUMBER OF SCANS PER
53700 1 AVERAGE',T52,F6.0,/,T20,'DECIMATION FOR PRINTER',T57,I2)
53800 WRITE(6,998)(XX(I),I=1,10)
53900 998 FORMAT(/' TIME',T13,10F12.5/)
54000 DPA=DP*CAL(LL)
54100 DO 10 I=1,IDIFF,IDP
54200 L=0
54300 DO 9J=I,N,IDIFF
54400 L=L+1
54500 VAL(L)=0.0
54600 DO 8 K=1,IDP
54700 8 VAL(L)=VAL(L)+XMEAN (M,J+K-1)
54800 9 VAL(L)=VAL(L)/DPA
54900 X=(I-1)/(SAMPRA*IDP)
55000 WRITE(6,1009)X,(VAL(II),II=1,L)
55100 1009 FORMAT(11F12.5)
55200 10 CONTINUE
55300 11 CONTINUE
55400 IF(F.LT.1.5)RETURN
55500 LL=0
55600 DO 21 M=1,NVAR
55700 15 LL=LL+1
55800 IF(NNV(LL).EQ.0)GO TO 15
55900 WRITE(6,1020)NAME
56000 1020 FORMAT('1', T20,'PRINTOUT OF STANDARD DEVIATIONS OF AN OBSERVATIO
56100 1N FOR PROBLEM' 2X,A4)
56200 WRITE(6,1001)(TITLE(I),I=1,14)
56300 WRITE(6,1002)LL,NAMCHN(LL),F,IDP
56400 WRITE(6,998)(XX(I),I=1,10)
56500 DPA=(CAL(LL)**2)*DP*(F-1.0)
56600 DO 30 I=1,IDIFF,IDP
56700 L=0
56800 DO 29 J=I,N,IDIFF
56900 L=L+1
57000 VAL(L)=0.0
57100 DO 28 K=1,IDP
57200 28 VAL(L)=VAL(L)+VAR(M,J+K-1)
57300 VAL(L)=VAL(L)/DPA
57400 29 VAL(L)=SQRT(VAL(L))
57500 X=(I-1)/(SAMPRA*IDP)
57600 WRITE(6,1009)X,(VAL(II),II=1,L)
57700 30 CONTINUE
57800 21 CONTINUE
57900 31 IOUT=5
58000 IF (IO.LE.0) GO TO 70
58100 NV=3*NVAR+1
58200 NS=N/IDG
58300 WRITE(IO,1040)NAME,NV,NS,NVAR,IOUT
58400 1040 FORMAT('PROBLM' A4,T13,I3,I5,I3,T69,I2,' 1')
58500 1041 FORMAT('(16A4)',T80,'5')
58600 WRITE(IO,1041)
58700 DG=IDG
58800 FF=(F-1.0)*DG*F
58900 IF(FF.LT.1.0)FF=1000000.
59000 NN=NS*IDG
59100 DO 50 I=1,NN,IDG
59200 LLL=0
59300 DO 48 J=1,NVAR
59400 45 LLL=LLL+1
59500 IF (NNV(LLL).EQ.0)GO TO 45
59600 FFA=(CAL(LLL)**2)*FF
59700 DGA=DG*CAL(LLL)
59800 VAL(J)=0
59900 VALV(J)=0.0
60000 DO 49 L=1,IDG
60100 VAL(J)=VAL(J)+XMEAN(J,I+L-1)
60200 49 VALV(J)=VALV(J)+VAR(J,I+L-1)
60300 VAL(J)=VAL(J)/DGA
60400 VALV(J)=SQRT(VALV(J)/FFA)
60500 VALVA(J)=VAL(J)-VALV(J)
60600 48 VALVB(J)=VAL(J)+VALV(J)
60700 X=(I-1)/SAMPRT
60800 WRITE (IO,1049) X,(VALVA(J),VAL(J),VALVB(J),J=1,NVAR)
60900 1049 FORMAT(16A4)
61000 50 CONTINUE
61100 L=0
61200 DO 60 M=1,NVAR
61300 59 L=L+1
61400 IF(NNV(L).EQ.0)GO TO 59
61500 MA=3*M-1
61600 MB=MA+1
61700 MC=MB+1
61800 WRITE(IO,1050)
61900 1050 FORMAT('SELECT2003001-1' T80,'3')
62000 WRITE (IO,1053) (TITLE(I),I=1,18)
62100 1053 FORMAT (2X,18A4,T80,'2')
62200 WRITE(IO,1051) L,NAMCHN(L)
62300 1051 FORMAT(T16,'VARIABLE NUMBER' I5,5X,'NAME' A6,T80,'2')
62400 WRITE (IO,1052) MA,MB,MC
62500 1052 FORMAT('CRSVAR' I3,'-',T16,I3,'*',T25,I3,'+',T80,'3')
62600 60 CONTINUE
62700 DIMENSION VARDIV(30),VARSTD(30),XMDIV(30),XMSTD(30)
62800 70 IF(KDIV.LE.0)GO TO 79
62900 NDIV=N/KDIV
63000 WRITE(6,1030)KDIV,NDIV
63100 1030 FORMAT('1 THE FOLLOWING ARE SUMMARY STATISTICS BASED ON THE AVER
63200 1AGES.'/5X,'THE AVERAGES WERE SPLIT INTO' I5,2X,'GROUPS WITH ABOUT'
63300 2 I5,2X,'VALUES IN EACH GROUP')
63400 L=0
63500 DO 75 I=1,NVAR
63600 DO 71 J=1,KDIV
63700 XMDIV(J)=0.0
63800 XMSTD(J)=0.
63900 VARDIV(J)=0.
64000 VARSTD(J)=0.
64100 71 CONTINUE
64200 72 L=L+1
64300 IF(NNV(L).LE.0)GO TO 72
64400 DO 74 J=1,KDIV
64500 KA=(J-1)*N/KDIV+1
64600 KB=J*N/KDIV
64700 DO 73 K=KA,KB
64800 XMDIV(J)=XMEAN(I,K)+XMDIV(J)
64900 XMSTD(J)=XMSTD(J)+XMEAN(I,K)*XMEAN(I,K)
65000 XY=ALOG(VAR(I,K))
65100 VARDIV(J)=VARDIV(J)+XY
65200 VARSTD(J)=VARSTD(J)+XY*XY
65300 73 CONTINUE
65400 XY=KB-KA+1
65500 XMDIV(J)=XMDIV(J)/(XY*CAL(L))
65600 XMSTD(J)=SQRT(ABS((XMSTD(J)/CAL(L)**2-XY*XMDIV(J)**2)/(XY-1)))
65700 VARSTD(J)=EXP(.5*(SQRT(ABS((VARSTD(J)-VARDIV(J)**2 /XY)/(XY-1)))))
65800 VARDIV(J)=EXP(.5*VARDIV(J)/XY)/(CAL(L)*SQRT(F-1.))
65900 74 CONTINUE
66000 WRITE(6,1074) L,NAMCHN(L)
66100 WRITE(6,1075)(XMDIV(J),J=1,KDIV )
66200 WRITE(6,1076)(XMSTD(J),J=1,KDIV)
66300 WRITE(6,1077)(VARDIV(J),J=1,KDIV)
66400 WRITE(6,1078)(VARSTD(J),J=1,KDIV)
66500 1074 FORMAT ('0SUMMARY FOR CHANNEL',I4,2X,A8)
66600 1075 FORMAT(' PARTIAL MEANS',(T30,10F10.3))
66700 1076 FORMAT (' STD DEV OF EACH MEAN',(T30,10F10.3))
66800 1077 FORMAT(' PARTIAL STD DEVS',(T30,10F10.3))
66900 1078 FORMAT(' SCALE FOR STD DEV',(T30,10F10.3))
67000 75 CONTINUE
67100 WRITE(6,1071)
67200 1071 FORMAT('1')
67300 79 CONTINUE
67400 RETURN
67500 END
67600 SUBROUTINE FPULSE(NV,PSTART,TSTART,SAMPRT,NPULS,LENGTH,IPRNT,IERRO
67700 1R)
67800 COMMON/BCDIN/INTAPE,KTYPE,FORMAT,LNTAPE,LUNIT,NUNIT,REWIND,HCODE,
67900 1 NAMP
68000 COMMON/PTABLE/NPCNT
68100 COMMON/OVERLY/NCASE
68200 INTEGER PSTART
68300 DIMENSION DATA(16,20),FORMAT(18,9),LUNIT(3,9)
68400 DATA YES/'YES '/
68500 LOGICAL IPRNT
68600 IERROR=0
68700 IF (KTYPE.NE.1.AND.KTYPE.NE.2) GO TO 225
68800 IF (NUNIT.EQ.0) GO TO 2100
68900 IF (INTAPE.EQ.1) WRITE (6,1001) INTAPE
69000 IF (LNTAPE.EQ.INTAPE) GO TO 213
69100 DO 2098 K=1,NUNIT
69200 IF (LNTAPE.EQ.LUNIT(1,K)) GO TO 2070
69300 2098 CONTINUE
69400 NUNIT=NUNIT+1
69500 LUNIT(2,NUNIT)=NCASE
69600 LUNIT(1,NUNIT)=LNTAPE
69700 LUNIT(3,NUNIT)=NPCNT
69800 GO TO 2060
69900 2070 LUNIT(2,K)=NCASE
70000 LUNIT(3,K)=NPCNT
70100 2060 DO 2065 I=1,NUNIT
70200 IF (INTAPE.EQ.LUNIT(1,I)) GO TO 2050
70300 2065 CONTINUE
70400 NUNIT=NUNIT+1
70500 LUNIT(1,NUNIT)=INTAPE
70600 NCASE=0
70700 NPCNT=0
70800 GO TO 213
70900 2050 NCASE=LUNIT(2,I)
71000 NPCNT=LUNIT(3,I)
71100 GO TO 213
71200 2100 LUNIT(1,1)=INTAPE
71300 NUNIT=NUNIT+1
71400 213 IF (PSTART.LT.NPCNT) GO TO 200
71500 IF (REWIND.EQ.YES) GO TO 201
71600 35 IF (NCASE.LE.0) WRITE(6,1) NAMP,INTAPE
71700 1 FORMAT (1H1//T40,'HEALTH SCIENCES COMPUTING FACILITY'/T40,34(1H-)
71800 1///T20,'POSITIONING FOR INPUT FOR PROBLEM NAMED',A5,' ON UNIT',
71900 1 I5/T60,'----'////)
72000 IF (TSTART.GE.0.) GO TO 15
72100 WRITE (6,12) TSTART
72200 12 FORMAT (' A NEGATIVE VALUE OF TSTART=',F12.2,' THIS IS NOT ALLOWED
72300 1IN BCD/BINARY POSITIONING'/' RECOMMENDATION--POSITION ON AN EARLIE
72400 2R PULSE AND USE A POSITIVE TSTART'/' FOR THE TIME BEING, TSTART WI
72500 3LL BE SET EQUAL TO ZERO AND THE JOB WILL CONTINUE')
72600 TSTART=0.0
72700 15 CONTINUE
72800 IF (IPRNT) WRITE (6,20) NPULS,HCODE,LENGTH,PSTART,TSTART
72900 20 FORMAT (' POSITIONING ON CHANNEL',I5,' USING A CUTOFF POINT OF',F1
73000 12.3,' AND A MINIMUM LENGTH OF',I4,' SCANS.'/' POSITION ON PULSE',
73100 2 I3,', TSTART=',F12.3)
73200 IF (PSTART.EQ.NPCNT.AND.TSTART.GT.0.) GO TO 50
73300 5 I=1
73400 11 IF (KTYPE.EQ.1) READ (INTAPE,FORMAT,ERR=130,END=150) (DATA(J,I),
73500 1J=1,NV)
73600 IF (KTYPE.EQ.2) READ (INTAPE,ERR=130,END=150) (DATA(J,I),J=1,NV)
73700 NCASE=NCASE+1
73800 C DETERMINE IF SCAN DOES NOT CONFORM TO PULSE SPECIFICATIONS
73900 IF(HCODE.GE.0.AND.DATA(NPULS,I).LE.HCODE)GO TO 5
74000 IF (HCODE.LT.0.AND.DATA(NPULS,I).GT.HCODE) GO TO 5
74100 IF (I.GE.LENGTH) GO TO 10
74200 I=I+1
74300 GO TO 11
74400 10 NPCNT=NPCNT+1
74500 SEC=FLOAT(NCASE)/SAMPRT
74600 WRITE (6,25) NPCNT,NCASE,SEC
74700 25 FORMAT (' PULSE',I5,', LEADING EDGE DETECTED AFTER READING',I6,
74800 1 ' SCANS(',F12.3,' SECONDS)')
74900 IF (NPCNT.LT.PSTART) GO TO 5
75000 50 NSKIP=TSTART*SAMPRT-1
75100 IF (NSKIP.LE.0) RETURN
75200 IF (KTYPE.EQ.1) GO TO 60
75300 DO 55 I=1,NSKIP
75400 NCASE=NCASE+1
75500 55 READ (INTAPE,ERR=130,END=150)
75600 RETURN
75700 60 DO 65 I=1,NSKIP
75800 NCASE=NCASE+1
75900 65 READ (INTAPE,FORMAT,ERR=130,END=150)
76000 RETURN
76100 130 PRINT 131,INTAPE,NPCNT,NCASE
76200 131 FORMAT (' AN I/O ERROR DETECTED ON INPUT TAPE ON LOGICAL UNIT',
76300 1 I4,' DURING OR AFTER DETECTION ON PULSE',I3,'. ',F12.2,' SCANS I
76400 1NTO TAPE'/' JOB WILL BE TERMINATED')
76500 140 IERROR=1
76600 RETURN
76700 150 PRINT 151,INTAPE,NPCNT,NCASE
76800 151 FORMAT (' END OF FILE DETECTED ON INPUT TAPE ON LOGICAL UNIT',I4,
76900 1' DURING OR AFTER DETECTION ON PULSE',I3,'. ',F12.2,' SCANS INTO
77000 2TAPE'//' JOB WILL CONTINUE')
77100 IERROR=-1
77200 RETURN
77300 200 CONTINUE
77400 C STARTING PULSE IS LESS THEN CURRENT POSITION ON THAT UNIT
77500 IF (PSTART.LT.0) GO TO 205
77600 201 IF (INTAPE.EQ.5) GO TO 210
77700 IF (REWIND.NE.YES) WRITE (6,202) INTAPE,NPCNT,PSTART
77800 202 FORMAT (' INCONGRUENCY FOUND--FOR INPUT TAPE ON UNIT',I3, /
77900 1' COLS. 72-73 SPECIFY NO REWIND ON PARAM CARD, YET PSTART IS LESS
78000 2THAN THE CURRENT POSITION ON TAPE'/10X,'CURRENT PULSE COUNT=',I4,
78100 33X,'PSTART=',I4/10X,'THIS IS A WARNING, THE TAPE WILL BE REWOUND')
78200 1001 FORMAT (' WARNING--THE INPUT TAPE IS ON UNIT',I3,' WHICH IS THE UN
78300 1IT USED BY THIS PROGRAM FOR CONVERSION')
78400 NCASE=0
78500 NPCNT=00
78600 REWIND INTAPE
78700 GO TO 35
78800 205 WRITE (6,206) PSTART
78900 206 FORMAT (' ERROR PSTART=',I5,' A NEGATIVE PSTART IS NOT ACCEPTABLE,
79000 1 JOB TERMINATED')
79100 GO TO 140
79200 210 CONTINUE
79300 NPCNT=0
79400 NCASE=0
79500 GO TO 35
79600 225 WRITE (6,226) KTYPE
79700 226 FORMAT (' ERROR IN CALL TO FPULSE, KTYPE=',I3/' JOB IS TERMINATED'
79800 1)
79900 GO TO 140
80000 END
80100
80200
80300
80400
80500
80600
80700
80800
80900