M0723 V02L01 1130 DPS (1130-CX-14X) 8/31/71 * // FOR M7230010 *LIST ALL M7230020 *NAME M0723 M7230030 ** PROGRAM MODULE 723 - READ CARD DATA FILES TYPE 1 M7230040 C PROGRAM IDENTIFICATION FOR THIS MODULE IS 0723 M7230050 C IT CONVERTS TYPE 1 CARD DATA FILES M7230060 DIMENSION IPACH(50) M7230065 DIMENSION ARRAY(150),IARR(90),PUTIN(20),IAREA(80),CYCLE(16) M7230070 DIMENSION DNAM(2) M7230090 COMMON LDR(625),LSW(15),MAN(255),NOMAN(255) M7230100 EQUIVALENCE (ARRAY(1),IARR(1)),(PUTIN(1),IAREA(1)),(NFL,NOMAN(95))M7230110 1,(NCB,NOMAN(93)),(NCTL,NOMAN(11)),(NRS,IARR(2)),(LHFCB,NOMAN(111))M7230120 2,(NOV,MAN(7)) M7230130 EQUIVALENCE (IARR(10),NFLO),(LLR,NOMAN(97)),(N12,NOMAN(12)), M7230140 1(N10,NOMAN(10)),(M3,MAN(3)),(M7,MAN(7)),(I1,IARR(1)),(I3,IARR(3)),M7230150 2(I4,IARR(4)),(I5,IARR(5)),(I6,IARR(6)),(I7,IARR(7)),(M8,MAN(8)), M7230160 3(I8,IARR(8)),(M2,MAN(2)),(N48,NOMAN(48)),(N11,NOMAN(11)) M7230170 DATADNAM/'M079','9'/,IPACH/1/ M7230190 CALL PSBFA(0) M7230200 CALL PLINP(0) M7230210 C SET ERROR INDICATORS M7230220 NCTL = 0 M7230230 N12 = 22 M7230240 C SET INPUT SEQUENCE FOR DIAGNOSTICS M7230250 N10 = M3 M7230260 C ******************* M7230270 C SET SIZE FOR DATA ARRAY M7230280 C ******************* M7230290 ISIZE = 150 M7230300 C COMPUTE NUMBER OF CYCLES ALLOWED M7230310 NOCA = (ISIZE - 10) / M7 - 2 M7230320 C SET INITIAL BUFFER M7230330 NBUF = 0 M7230340 C SET VARIABLE NUMBER TO OUTPUT M7230350 DO 5 I=1,NOV M7230360 IDX = 11 + (NOCA + 2) * (I - 1) M7230370 ARRAY(IDX) = MAN(10 * I + 1) M7230380 C SET PEN CONTROL OFF M7230390 5 ARRAY(IDX + 1) = 0. M7230400 C SET COLUMN INDICATOR M7230410 JCOL = 81 M7230420 C SET LOOP FOR MAXIMUM NUMBER OF CYCLES ALLOWED M7230430 10 DO 45 NOCP=1,NOCA M7230440 NCIC = 0 M7230450 C MOVE VARIABLES TO OUTPUT M7230460 DO 40 I1=1,NOV M7230470 C COMPUTE DEFINER INDEX M7230480 IDX = I1 * 10 + 4 M7230490 C FIND STORAGE INDEX M7230500 ISDX = 12 + NOCP + (NOCA + 2) * (I1 - 1) M7230510 C CHECK FORMAT OF VARIABLE M7230520 IF (MAN(IDX) - 1) 15,20,25 M7230530 C ERROR-NORMAL VARIABLE DEFINED FOR TYPE 1 FILE M7230540 15 NERR = 1 M7230550 GOTO 190 M7230560 C GENERATE IMPLIED VARIABLE M7230570 20 ARRAY(ISDX) = MAN(IDX - 2) M7230580 C GENERATE NEXT IMPLIED VALUE M7230590 MAN(IDX - 2) = MAN(IDX - 2) + MAN(IDX - 1) M7230600 GOTO 40 M7230610 C ACCESS CONTINUOUS VARIABLE M7230620 25 NOVS = MAN(IDX - 2) M7230630 IF (NCIC) 30,30,35 M7230640 30 NCIC = MAN(IDX - 1) M7230650 GOTO 95 M7230660 35 ARRAY(ISDX) = CYCLE(NOVS) M7230670 40 CONTINUE M7230680 45 CONTINUE M7230690 C IF THIS LOOP DROPS THROUGH IT MEANS THAT ARRAY IS FULL AND MUST BEM7230700 C WRITTEN OUT AND A CONTINUATION ARRAY ESTABLISHED M7230710 C SET OVERFLOW SWITCH ON M7230720 NOVL = 1 M7230730 C COMPUTE RECORD SIZE M7230740 NRS = 10 + (NOCA + 2) * NOV M7230750 C SET RECORD IDENTIFICATION M7230760 NOCP = NOCP - 1 M7230770 50 I1 = 2 M7230780 C SET INPUT SEQUENCE M7230790 I3 = M3 M7230800 C SET BACKWARD POINTER M7230810 I4 = NFL - LLR M7230820 C SET NUMBER OF ENTRIES OF EACH VARIABLE M7230830 I5 = NOCP M7230840 C SET NUMBER OF VARIABLES M7230850 I6 = NOV M7230860 C SET STARTING VARIABLE NUMBER M7230870 I7 = M8 M7230880 C SET NO VARIABLES WITH PEN CONTROL M7230890 I8 = 0 M7230900 C IS OVERFLOW RECORD REQUIRED M7230910 IF (NOVL) 60,60,55 M7230920 C SET OVERFLOW CONTROL DISPLACEMENT M7230930 55 NFLO = NFL + NRS M7230940 GOTO 65 M7230950 60 NFLO = 0 M7230960 C WRITE DATA TO FILE M7230970 65 CALL WRITE(NCB,NFL,NRS,IARR) M7230980 C UPDATE BUFFER PROCESSED COUNT M7230990 NBUF = NBUF + 1 M7231000 C UPDATE FILE SIZE M7231010 NFL = NFL + NRS M7231020 C UPDATE LENGTH OF LAST RECORD M7231030 LLR = NRS M7231040 C FIND MINIMUM AND MAXIMUM OF EACH VARIABLE M7231050 DO 70 I=1,NOV M7231060 C COMPUTE MINIMUM INDEX AND MAXIMUM INDEX M7231070 IDXM = 10 * I + 5 M7231080 C COMPUTE DISPLACEMENT TO DATA LINE M7231090 ISDX = 13 + (NOCP + 2) * (I - 1) M7231100 C FIND MIN AND MAX M7231110 CALL MINAX(MAN(IDXM),MAN(IDXM + 1),ARRAY(ISDX),NOCP) M7231120 C WRITE HIGH LOW DATA M7231130 IDX = MAN(10 * I + 1) * 2 + 4 M7231140 CALL WRITE(LHFCB,IDX,2,MAN(IDXM)) M7231150 70 CONTINUE M7231160 IF (NOVL) 75,75,10 M7231170 C RESET DISPLACEMENT INDICATOR M7231180 75 N48 = N48 + M2 M7231190 C WERE ANY ERRORS ENCOUNTERED M7231200 80 IF (N11) 85,85,90 M7231210 C SET PROPER EXIT M7231220 85 CALL LRET M7231230 90 CALL LEX(2,DNAM) M7231240 C CYCLE CONVERSION SECTION M7231250 C IS NEW CARD READ REQUIRED M7231260 95 DO 135 LOOP=1,NCIC M7231270 100 IF (JCOL - 80) 120,120,105 M7231280 C READ CARD M7231290 105 CALL PAIN(0,1,80,PUTIN) M7231300 C DIVIDE CARD 1 COLUMN PER WORD M7231310 DO 110 I=1,20 M7231320 I2 = 21 - I M7231330 I3 = I2 * 4 - 3 M7231340 110 CALL BREAK(IAREA(I2),IAREA(I3)) M7231350 C CHECK FOR UREND M7231360 IF (PEOF(0)) 140,140,115 M7231370 C SET COLUMN INDICATOR M7231380 115 JCOL = 1 M7231390 CALL PLINP(0) M7231400 C CHECK FOR LEADING BLANKS M7231410 120 IF (IAREA(JCOL) - 64) 130,125,130 M7231420 C ADJUST COLUMN COUNT M7231430 125 JCOL = JCOL + 1 M7231440 GOTO 100 M7231450 C SET MAX FIELD SIZE FROM CURRENT COLUMN TO END OF CARD M7231460 130 KT = JCOL - 81 M7231470 C CONVERT M7231480 135 CALL FLICR(IAREA,JCOL,KT,CYCLE(LOOP)) M7231490 GOTO 35 M7231500 C UREND HAS BEEN PROCESSED M7231510 C COMPRESS DATA TABLE M7231520 C SET EXTRA SKIP COUNTER M7231530 C IS PARTIAL LOOP COMPLETED M7231540 140 IF (LOOP - 1) 145,145,185 M7231550 C IS THERE A NULL ARRAY M7231560 145 IF (NOCP - 1) 150,150,160 M7231570 C IS THERE A NULL DATA SET M7231580 150 IF (NBUF) 75,75,155 M7231590 C RESET OFLO IN LAST RECORD M7231600 155 CALL WRITE(NCB,NFL - NRS + 9,1,0) M7231610 GOTO 75 M7231620 160 I1 = 0 M7231630 NOCP = NOCP - 1 M7231640 C SET STORE INDEX M7231650 I2 = 13 + NOCP M7231660 C SET ONE CYCLE SKIP COUNTER M7231670 I3 = NOCA - NOCP M7231680 C SET MOVE LIMIT M7231690 JLIM = NOCP + 2 M7231700 C PROCESS DATA LINES M7231710 IF (NOV - 1) 180,180,165 M7231720 165 DO 175 I4=2,NOV M7231730 DO 170 I5=1,JLIM M7231740 C ACCESS INDEX M7231750 I6 = I2 + I3 + I1 M7231760 C COMPRESS TABLE M7231770 ARRAY(I2) = ARRAY(I6) M7231780 C TO NEXT VALUE M7231790 170 I2 = I2 + 1 M7231800 C MODIFY EXTRA SKIP M7231810 I1 = I1 + I3 M7231820 175 CONTINUE M7231830 C SAVE ARRAY SIZE M7231840 180 NRS = I2 - 1 M7231850 C RESET OVERFLOW M7231860 NOVL = 0 M7231870 GOTO 50 M7231880 C INCOMPLETE CYCLE OF DATA PROCESSED M7231890 185 NERR = 2 M7231900 C ERROR PROCESSING M7231910 190 NCTL = NCTL + 1 M7231920 K = NCTL + 12 M7231930 NOMAN(K) = NERR M7231940 GOTO(80,145),NERR M7231950 END M7231960 // DUP M7231970 *DELETE M0723 M7231980 *DUMP WS CD M0723 M7231990 *STORECI WS UA M0723 1 M7232000 *LOCAL,WRITE,FLICR M7232010