C***** PART12 ****************************************************H0005400 C***** JAN.1974 REV.1 H0005405 C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS H0005410 C***** H0005415 C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3 H0005420 C***** H0005425 C***** JUNE 1974 H0005430 C***** H0005435 C***** PART 12 OF 14 PARTS H0005440 C***** H0005445 C***** SEGMENTS INCLUDED H0005450 C***** H0005455 C***** BLKDA - 179 BLOCK DATA TEST H0005460 C***** H0005465 C***** BLAKD - 419 BLOCK DATA SUBPROGRAM H0005470 C***** H0005475 C***** BLBKD - 429 BLOCK DATA SUBPROGRAM H0005480 C***** H0005485 C***** BLCKD - 439 BLOCK DATA SUBPROGRAM H0005490 C***** H0005495 C***** UNFRW - 180 UNFORMATTED READ AND WRITE H0005500 C***** H0005505 C***** BACUP - 182 BACKSPACE TAPE H0005510 C***** H0005515 C***** DOTRM - 190 DO LOOPS (TERMINAL STATEMENTS) H0005520 C***** H0005525 C***** DOLMT - 191 DO LOOPS (INTEGER VARIABLES - PARAMETERS) H0005530 C***** H0005535 C***** DONSC - 192 DO LOOPS (COMPLETELY NESTED NEST) H0005540 C***** H0005545 C***** DONSI - 193 DO LOOPS (INCOMPLETE) H0005550 C***** H0005555 C***** DONSX - 194 DO LOOPS (EXTENDED RANGE) H0005560 C***** H0005565 C***** DONML - 195 DO LOOPS (NESTED NEST) H0005570 C***** H0005575 C***** DONIO - 196 DO LOOPS (I/O TERMINAL STATEMENTS) H0005580 C***** H0005585 C***** MORDO - 197 DO LOOPS (I/O, INTRINSIC FUNCTION, CALL) H0005590 C***** H0005595 C***** BSFDF - 005 STATEMENT FUNCTIONS H0005600 C***** H0005605 C***** MDQ - 412 SUBROUTINE SUBPROGRAM H0005610 C***** H0005615 C***** SUBR1 - 200 SUBROUTINE CALLED H0005620 C***** H0005625 C***** SUBRQ - 410 SUBROUTINE SUBPROGRAM H0005630 C***** H0015400 C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS H0015405 C***** 179, 180, 182, 190, 191, 192, 193, 194, 195, 196, 197, 200 H0015410 C***** ARE RUN AS ONE MAIN PROGRAM. H0015415 C***** H0015420 DIMENSION MCA1I(5) H0015425 DIMENSION IV1I(1024), IAC1I(5), AC2S(5,6) H0015430 DIMENSION CMA1S(5), CMB1S(5), AC1S(25) H0015435 INTEGER MCA3I(2,3,3) , I3I(2,2,2) H0015440 LOGICAL MCAVB, MCBVB, GH2B(1,2) H0015445 DOUBLE PRECISION CC3D(7,2,2), DPAVD, DPBVD H0015450 COMPLEX NUMVC, DENVC, LL1C(32) H0015455 COMMON AXVS, CXVS H0015460 DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D H0015465 COMPLEX DXVC, DX1C, DX2C, DZ3C H0015470 COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H0015475 A /BLK2/DXVS, DX1S(2), DX2S(2,2) H0015480 B /BLK3/DXVD, DX1D(2), DX2D(2,2) H0015485 C /BLK4/DXVC, DX1C(2), DX2C(2,2) H0015490 D /BLK5/DXVB, DX1B(2), DX2B(2,2) H0015495 E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2), H0015500 F DZ3C(2,2,2), DX3B(2,2,2)// IXVI, IAX1I(4) H0015505 LOGICAL DXVB, DX1B, DX2B, DX3B H0015510 C***** H0015515 C***** END OF SPECIFICATIONS FOR SEGMENTS H0015520 C***** 179, 180, 182, 190, 191, 192, 193, 194, 195, 196, 197, 200 H0015525 C***********************************************************************H0050500 C***** H0050510 C***** BSFDF - (005) H0050520 C***** H0050530 C***********************************************************************H0050540 C***** GENERAL PURPOSE ASA REF H0050550 C***** DEFINING STATEMENT FUNCTIONS THAT ARE TO BE TESTED H0050560 C***** IN SEGMENT 197 8.1.1H0050570 C***** HEADER FOR SEGMENT 005 H0050580 C***** DEFINING EXPRESSION CONTAINS CONSTANTS AND VARIABLES H0050590 CMAFS(CAWVS,CBWVS) = CAWVS * 2. + CBWVS H0050600 CMBFS(MAWVI,MBWVI,MCWVI) =(MAWVI + MBWVI + MCWVI)/3 H0050610 MCAFI(MAWVI,MBWVI) = MAWVI ** MBWVI H0050620 MCBFI(CAWVS,CBWVS,CCWVS) = (CAWVS + CBWVS + CCWVS) * 2.0 H0050630 C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES AND H0050640 C***** INTRINSIC FUNCTIONS H0050650 CMCFS(CAWVS,CBWVS,CCWVS) = ABS(CAWVS**2 - (CBWVS+CCWVS)**2) H0050660 CMDFS(MAWVI,MBWVI) = ISIGN((MAWVI+MBWVI),(MAWVI-MBWVI)) H0050670 MCCFI(MAWVI,MBWVI,CAWVS) = MAWVI**2 + MBWVI**2 + IFIX(CAWVS)**2 H0050680 MCDFI(CAWVS,CBWVS,CCWVS,CDWVS,CEWVS) = (CAWVS + CBWVS + CCWVS + H0050690 1CDWVS +CEWVS) ** (ABS(CAWVS)) H0050700 C***** DEFINING EXPRESSION CONTAINS PREVIOUSLY DEFINED STATEMENT H0050710 C***** FUNCTIONS AND/OR EXTERNAL FUNCTION REFERENCES H0050720 CMEFS(CAWVS,CBWVS) = CMBFS(1,2,3) + SQRT((CAWVS + CBWVS)) H0050730 CMFFS(MAWVI,MBWVI,MCWVI) = MCCFI(MAWVI,MBWVI,3.0) + MCWVI **2 H0050740 MCEFI(MAWVI,MBWVI) = MCAFI(MAWVI,MBWVI) ** MCAFI(MAWVI,MBWVI) H0050750 MCFFI(CAWVS,CBWVS,CCWVS) = SQRT(CAWVS) + SQRT(CBWVS) + EXP(CCWVS) H0050760 C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES, INTRINSIC H0050770 C***** OR EXTERNAL FUNCTION REFERENCES AND PREVIOUSLY DEFINED H0050780 C***** STATEMENT FUNCTIONS. H0050790 CMGFS(MAWVI,MBWVI,CAWVS,CBWVS) = FLOAT(MAWVI ** 2) - CMAFS(CAWVS, H0050800 1CBWVS) + SQRT((FLOAT(MAWVI + MBWVI))) H0050810 MCGFI(MAWVI,MBWVI,MCWVI,CAWVS) = MCEFI(MAWVI,MBWVI) - MCEFI(MAWVI,H0050820 1MCWVI) + IFIX(EXP(CAWVS)) H0050830 C***** END OF TEST SEGMENT 005 H0050840 C***********************************************************************H1790010 C***** H1790020 C***** BLKDA - (179) H1790030 C***** H1790040 C***********************************************************************H1790050 C***** GENERAL PURPOSE ASA REF H1790060 C***** TO TEST BLOCK DATA SUBPROGRAMS 8.5 H1790070 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS 419, 429, 439. THIS H1790080 C***** SEGMENT WRITES OUT THE DATA FORMED IN SEGMENT 419, 429, 439 H1790090 C***** H1790100 C***** S P E C I F I C A T I O N S SEGMENT 179 H1790110 C***** H0015530 C***** WHEN EXECUTING ONLY SEGMENT 179, REMOVE THE PRECEDING H0015535 C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR H0015540 C***** AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0015545 C***** H0015550 C= DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D H0015555 C= COMPLEX DXVC, DX1C, DX2C, DZ3C H0015560 C= COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H0015565 C= A /BLK2/DXVS, DX1S(2), DX2S(2,2) H0015570 C= B /BLK3/DXVD, DX1D(2), DX2D(2,2) H0015575 C= C /BLK4/DXVC, DX1C(2), DX2C(2,2) H0015580 C= D /BLK5/DXVB, DX1B(2), DX2B(2,2) H0015585 C= E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2), H0015590 C= F DZ3C(2,2,2), DX3B(2,2,2) H0015595 C= LOGICAL DXVB, DX1B, DX2B, DX3B H0015600 C***** H0015605 C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS H1790120 IRVI = 5 H0075400 NUVI = 6 H0075405 INVI = 9 H0075410 C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS H0075415 WRITE(NUVI,0071) H0075420 0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S// H0075425 1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS// H0075430 3 37H FOR USE ON LARGE FORTRAN PROCESSORS // H0075435 4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966// H0075440 5 23H VERSION 3 PART 12///) H0075445 C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER H0075450 C PREPARED BY USER H0075455 C READ, NO LIST H0075460 C PREPARED BY USER H0075465 C READ, NO LIST H0075470 C PREPARED BY USER H0075475 C READ, NO LIST H0075480 C READ(IRVI,0070) H0075485 C READ(IRVI,0072) H0075490 C READ(IRVI,0073) H0075495 0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /) H0075500 0072 FORMAT(40H TEST PROGRAMS /) H0075505 0073 FORMAT(40H FORTRAN COMPILER /) H0075510 WRITE(NUVI,0070) H0075515 WRITE(NUVI,0072) H0075520 WRITE(NUVI,0073) H0075525 C***** H0075530 C***** H0075535 C***** WRITE HEADING FOR SEGMENT 179 H1790130 WRITE (NUVI,1790) H1790140 1790 FORMAT (1H1,1X,32HBLKDA - (179) SEVERAL BLOCK DATA/ 16X, H1790150 1 11HSUBPROGRAMS/ 2X, 14HASA REF. - 8.5// 9H RESULTS) H1790160 WRITE (NUVI,1791) H1790170 1791 FORMAT (//28H TEST IS SUCCESSFUL IF EACH/ H1790180 A28H GROUP CONTAINS SAME VALUES) H1790190 WRITE (NUVI,1792) JXVI, JAX1I(1), JAX2I(1,2), JAX3I(1,1,2), DXVS, H1790200 A DX1S(2), DX2S(1,2), DX3S(1,1,2), DXVD, DX1D(1), H1790210 B DX2D(1,2), DX3D(1,1,2), DXVC, DX1C(1),DX2C(1,2),H1790220 C DZ3C(1,1,2), DXVB, DX1B(1), DX2B(1,2), H1790230 D DX3B(1,1,2), JAX2I(1,3), H1790240 E DX3B(2,2,2), DX2S(2,1) H1790250 1792 FORMAT (// 4(I10/)// H1790260 A 4(F12.1/)// H1790270 B 4(1PD16.1/)// H1790280 C 4(0PF6.1,F6.1/)// H1790290 D 4(L10/)// H1790300 E 3(2H ,A2/)) H1790310 C***** END OF TEST SEGMENT 179 H1790320 C***** WHEN EXECUTING ONLY SEGMENT 179, THE STOP AND END CARDS H1790330 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1790340 C***** IN COLUMNS 1 AND 2 REMOVED. H1790350 C= STOP H1790360 C= END H1790370 C***********************************************************************H1800010 C***** H1800020 C***** UNFRW - (180) H1800030 C***** H1800040 C***********************************************************************H1800050 C***** GENERAL PURPOSE ASA REF H1800060 C***** TEST OF UNFORMATTED READ AND WRITE STATEMENTS 7.1.3.2.4H1800070 C***** 7.1.3.2.5H1800080 C***** S P E C I F I C A T I O N S SEGMENT 180 H1800090 C***** H0015610 C***** WHEN EXECUTING ONLY SEGMENT 180, THE SPECIFICATION STATEMENTS H0015615 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0015620 C***** IN COLUMNS 1 AND 2 REMOVED. H0015625 C***** H0015630 C= DIMENSION CMA1S(5), CMB1S(5), AC1S(25) H0015635 C***** H0015640 C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE. H1800100 C***** H0075540 C***** WHEN EXECUTING ONLY SEGMENT 180, THE FOLLOWING STATEMENTS H0075545 C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075550 C***** H0075555 C= NUVI = 6 H0075560 C= INVI = 9 H0075565 C***** H0075570 WRITE (NUVI,0180) H1800110 180 FORMAT(1H1,1X,30HUNFRW - (180) UNFORMATTED READ/ 14X, H1800120 122H AND WRITE STATEMENTS//36H ASA REFS - 7.1.3.2.4 AND 7.1.3.2.5H1800130 2//10H RESULTS ) H1800140 C***** HEADER FOR SEGMENT 180 WRITTEN H1800150 CMAVS = 1.5E01 H1800160 CMBVS = -2.75E-0 H1800170 MCAVI = 5 H1800180 MCBVI = -10 H1800190 DPAVS = 1.02E0 H1800200 DPBVS = 9876.0E-2 H1800210 CMA1S(1) = 1.0E0 H1800220 CMA1S(2) = 2.0E0 H1800230 CMA1S(3) = 3.0E0 H1800240 CMA1S(4) = 4.0E0 H1800250 CMA1S(5) = 5.0E0 H1800260 C***** WRITE AND READ VARIABLES OF THE SAME TYPE H1800270 REWIND INVI H1800280 WRITE (INVI) CMAVS, CMBVS H1800290 WRITE (INVI) MCAVI, MCBVI H1800300 WRITE (INVI) DPAVS, DPBVS H1800310 WRITE (INVI) CMA1S H1800320 WRITE (INVI) (CMA1S(IVI), IVI = 1,5,1 ) H1800330 REWIND INVI H1800340 READ (INVI) CMCVS, CMDVS H1800350 READ (INVI) MCCVI, MCDVI H1800360 READ (INVI) DPCVS, DPDVS H1800370 READ (INVI) CMB1S H1800380 READ (INVI) (AC1S(IVI), IVI = 1,5,1 ) H1800390 C***** CHECK RECORDS BY SUBTRACTING CORRESPONDING VALUES. H1800400 CMEVS = CMAVS - CMCVS H1800410 CMFVS = CMBVS - CMDVS H1800420 MCEVI = MCAVI - MCCVI H1800430 MCFVI = MCBVI - MCDVI H1800440 DPEVS = DPAVS - DPCVS H1800450 DPFVS = DPBVS - DPDVS H1800460 ACVS = CMA1S(1) - CMB1S(1) H1800470 BCVS = CMA1S(2) - CMB1S(2) H1800480 CCVS = CMA1S(3) - CMB1S(3) H1800490 DCVS = CMA1S(4) - CMB1S(4) H1800500 FFCVS = CMA1S(5)- CMB1S(5) H1800510 CMGVS = CMA1S(1) - AC1S(1) H1800520 CMHVS = CMA1S(2) - AC1S(2) H1800530 CMIVS = CMA1S(3) - AC1S(3) H1800540 CMJVS = CMA1S(4) - AC1S(4) H1800550 CMKVS = CMA1S(5) - AC1S(5) H1800560 WRITE (NUVI,181) CMEVS, CMFVS, MCEVI, MCFVI, DPEVS, DPFVS, H1800570 1 ACVS, BCVS, CCVS, DCVS, FFCVS, CMGVS, CMHVS, CMIVS, CMJVS,H1800580 2 CMKVS H1800590 0181 FORMAT (//2(F20.10/),2(I19/),7(F20.10/)) H1800600 C***** READ AND WRITE VARIABLES OF DIFFERENT TYPES H1800610 REWIND INVI H1800620 WRITE (INVI) CMAVS, MCAVI H1800630 WRITE (INVI) CMA1S(1), CMA1S(2), CMBVS, MCBVI H1800640 WRITE (INVI) CMA1S(3), CMA1S(4), CMA1S(5), DPAVS, DPBVS H1800650 REWIND INVI H1800660 READ (INVI) CMCVS, MCCVI H1800670 READ (INVI) CMB1S(1), CMB1S(2), CMDVS, MCDVI H1800680 READ (INVI) CMB1S(3), CMB1S(4), CMB1S(5), DPCVS, DPDVS H1800690 CMEVS = CMAVS - CMCVS H1800700 CMFVS = CMBVS - CMDVS H1800710 MCEVI = MCAVI - MCCVI H1800720 MCFVI = MCBVI - MCDVI H1800730 DPEVS = DPAVS - DPCVS H1800740 DPFVS = DPBVS - DPDVS H1800750 CMGVS = CMA1S(1) - CMB1S(1) H1800760 CMHVS = CMA1S(2) - CMB1S(2) H1800770 CMIVS = CMA1S(3) - CMB1S(3) H1800780 CMJVS = CMA1S(4) -CMB1S(4) H1800790 CMKVS = CMA1S(5) - CMB1S(5) H1800800 WRITE (NUVI,0182) CMEVS, CMFVS, MCEVI, MCFVI, DPEVS, DPFVS, CMGVS,H1800810 1 CMHVS, CMIVS, CMJVS, CMKVS H1800820 0182 FORMAT (//2(F20.10/),2(I19/),7(F20.10/)) H1800830 C***** TEST UNFORMATTED READ WITH NO LIST H1800840 REWIND INVI H1800850 WRITE (INVI) CMAVS, MCAVI H1800860 WRITE (INVI) CMA1S H1800870 WRITE (INVI) CMBVS, MCBVI H1800880 WRITE (INVI) CMA1S(5),CMA1S(4),CMA1S(3),CMA1S(2),CMA1S(1) H1800890 C***** ENDFILE CAN NOT BE TESTED, BUT INCLUDED FOR ACCEPTANCE AS H1800900 C***** A STATEMENT. H1800910 ENDFILE INVI H1800920 REWIND INVI H1800930 C*****CHECK THAT A RECORD IS READ WHEN NO LIST IS SUPPLIED BY COMPARING H1800940 C***** VALUES OF THE THIRD RECORD H1800950 READ (INVI) CMCVS, MCCVI H1800960 READ (INVI) H1800970 READ (INVI) CMDVS, MCDVI H1800980 CMEVS = CMAVS - CMCVS H1800990 CMFVS = CMBVS - CMDVS H1801000 MCEVI = MCAVI - MCCVI H1801010 MCFVI = MCBVI - MCDVI H1801020 WRITE (NUVI, 0183) CMEVS, CMFVS, MCEVI, MCFVI H1801030 183 FORMAT(//2(F20.10/),2(I19/)) H1801040 WRITE (NUVI,0184) H1801050 184 FORMAT(37H0 ALL ABOVE ANSWERS SHOULD BE ZERO IF / H1801060 1 37H THE READ AND WRITE RECORDS COMPARE. ) H1801070 REWIND INVI H1801080 C***** END OF TEST SEGMENT 180 H1801090 C***** WHEN EXECUTING ONLY SEGMENT 180, THE STOP AND END H1801100 C***** CARDS WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H1801110 C***** IN COLUMNS 1 AND 2 REMOVED. H1801120 C= STOP H1801130 C= END H1801140 C***********************************************************************H1820010 C***** H1820020 C***** BACUP (182) H1820030 C***** H1820040 C***********************************************************************H1820050 C***** GENERAL PURPOSE ASA REF H1820060 C***** WRITE A BLOCK, 1024 WORDS IN LENGTH, UNFORMATTED, 7.1.3.2.5H1820070 C***** TO TAPE,BACKSPACE, READ TO MEMORY 7.1.3.3.2H1820080 C***** 7.1.3.2.4H1820090 C***** S P E C I F I C A T I O N S SEGMENT 182 H1820100 C***** H0015645 C***** WHEN EXECUTING ONLY SEGMENT 182, THE SPECIFICATION STATEMENTS H0015650 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0015655 C***** IN COLUMNS 1 AND 2 REMOVED. H0015660 C***** H0015665 C= DIMENSION IV1I(1024) H0015670 C***** H0015675 C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE. H1820110 C***** H0075575 C***** WHEN EXECUTING ONLY SEGMENT 182, THE FOLLOWING STATEMENTS H0075580 C***** NUVI=6 AND IRVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075585 C***** H0075590 C= NUVI = 6 H0075595 C= INVI = 9 H0075600 C***** H0075605 1820 FORMAT(1H1,1X,28HBACUP - (182) BACKSPACE TAPE//2X,18HASA REF. 7.1.H1820120 33.3.2//9H RESULTS) H1820130 WRITE(NUVI,1820) H1820140 C***** HEADER FOR SEGMENT 182 WRITTEN H1820150 C***** H1820160 REWIND INVI H1820170 C***** CREATE A LIST, 1024 WORDS IN LENGTH, CONTAINING H1820180 C***** THE INTEGERS 1 TO 1024, ONE INTEGER PER WORD. H1820190 ISVI = 0 H1820200 MRRVI = 1 H1820210 1821 ISVI = ISVI + 1 H1820220 IV1I(ISVI) = ISVI H1820230 IF (ISVI - 1024) 1821, 1822, 1823 H1820240 C***** WRITE THE LIST TO AN INTERMEDIATE TAPE H1820250 1822 WRITE (INVI) IV1I H1820260 WRITE(NUVI,1828) MRRVI, (IV1I(JCVI), JCVI=1,9), H1820270 1 (IV1I(KCVI),KCVI=1016,1024) H1820280 C***** CHANGE MEMORY VALUES TO 5 TIMES THE ORIGINAL VALUES H1820290 MRRVI = 2 H1820300 ISVI = 0 H1820310 1825 ISVI = ISVI + 1 H1820320 IV1I(ISVI) = 5 * ISVI H1820330 IF (ISVI - 1024) 1825,1826,1823 H1820340 1826 BACKSPACE INVI H1820350 C***** WRITE THE CHANGED VALUES H1820360 WRITE(NUVI,1828) MRRVI, (IV1I(JCVI), JCVI=1,9), H1820370 1 (IV1I(KCVI),KCVI=1016,1024) H1820380 MRRVI = 3 H1820390 C***** READ INTERMEDIATE TAPE WHICH HAS BEEN BACKSPACED H1820400 READ(INVI) IV1I H1820410 REWIND INVI H1820420 C***** WRITE INITIAL VALUES FROM BACKSPACED TAPE. H1820430 WRITE(NUVI,1828) MRRVI,(IV1I(LVI), LVI=1,9),(IV1I(KVI),KVI= H1820440 1 1016, 1024) H1820450 1823 WRITE (NUVI,1829) H1820460 1828 FORMAT(//7H GROUP,I3,3(/2X,3(I6)), 3(/2X,3(I6))) H1820470 1829 FORMAT(//2X,33HGROUPS 1 AND 3 SHOULD BE THE SAME/ H1820480 I 30H AND GROUP 2, 5 TIMES GROUP 1) H1820490 C***** END OF TEST SEGMENT 182 H1820500 C***** WHEN EXECUTING ONLY SEGMENT 182, THE STOP AND END H1820510 C***** CARDS WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H1820520 C***** IN COLUMNS 1 AND 2 REMOVED. H1820530 C= STOP H1820540 C= END H1820550 C***********************************************************************H1900010 C***** H1900020 C***** DOTRM - (190) H1900030 C***** H1900040 C***********************************************************************H1900050 C***** H1900060 C***** GENERAL PURPOSE ASA REF H1900070 C***** DO LOOPS TESTED WITH ALL ALLOWABLE 7.1.2.8 H1900080 C***** TERMINAL STATEMENTS (I/O TESTED SEPARATELY) H1900090 C***** CONTINUE, ASSIGN, LOGICAL IF H1900100 C***** RESTRICTIONS OBSERVED H1900110 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/23H1900120 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1900130 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1900140 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1900150 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1900160 C***** DO STATEMENT H1900170 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54H1900180 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01H1900190 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1900200 C***** * CONTROL IS NEVER PASSED INTO RANGE OF DO FROM 7.1.2.8.2/44H1900210 C***** OUTSIDE ITS RANGE H1900220 C***** H1900230 C***** S P E C I F I C A T I O N S SEGMENT 190 H1900240 C***** H0015680 C***** WHEN EXECUTING ONLY SEGMENT 190, THE SPECIFICATION STATEMENTS H0015685 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0015690 C***** IN COLUMNS 1 AND 2 REMOVED. H0015695 C***** H0015700 C= DIMENSION IAC1I(5) H0015705 C***** H0015710 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1900250 C***** H0075610 C***** WHEN EXECUTING ONLY SEGMENT 190, THE FOLLOWING STATEMENT H0075615 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075620 C***** H0075625 C= NUVI = 6 H0075630 C***** H0075635 WRITE (NUVI,8906) H1900260 8906 FORMAT (1H1,1X,25HDOTRM - (190) DO TERMINAL//2X, H1900270 -17HASA REF - 7.1.2.8//2X,7HRESULTS) H1900280 C***** HEADER FOR SEGMENT 190 H1900290 C***** CONTINUE WITH EXPLICIT INCREMENT**********************7.1.2.8 H1900300 WRITE (NUVI,8905) H1900310 8905 FORMAT (//2X,23HTEST1 CONTINUE EXPLICIT) H1900320 C***** HEADER FOR CONTINUE EXPLICIT TEST H1900330 DO 1901 JACVI = 1,4,1 H1900340 IAC1I(JACVI) = JACVI H1900350 1901 CONTINUE H1900360 IF (IAC1I(1)-1) 1909,1902,1909 H1900370 1902 IF (IAC1I(2)-2) 1909,1903,1909 H1900380 1903 IF (IAC1I(3)-3) 1909,1904,1909 H1900390 1904 IF (IAC1I(4)-4) 1909,1905,1909 H1900400 C***** WRITE OUT ERROR MESSAGE H1900410 1909 MRRVI=1 H1900420 WRITE (NUVI,8904)MRRVI H1900430 8904 FORMAT (/2X,6H**TEST,I1,1X,17HINDICATES ERROR**) H1900440 C***** ERROR FOR CONTINUE EXPLICIT TEST H1900450 GO TO 8909 H1900460 C***** NO ERROR H1900470 C***** WRITE OUT CONTINUE EXPLICIT TEST IS SUCCESS H1900480 1905 MRRVI=1 H1900490 WRITE (NUVI,8903)MRRVI H1900500 8903 FORMAT (/2X,6H**TEST,I1,1X,12HSUCCESSFUL**) H1900510 C***** SUCCESS FOR CONTINUE EXPLICIT TEST H1900520 C***** CONTINUE TERMINAL IMPLIED TEST************************7.1.2.8 H1900530 WRITE (NUVI,8902) H1900540 8902 FORMAT (//2X,22HTEST2 CONTINUE IMPLIED) H1900550 C***** HEADER FOR CONTINUE IMPLIED TEST H1900560 8909 LCCVI=2 H1900570 DO 7900 KBCVI = LCCVI,4 H1900580 7900 IAC1I(KBCVI) = KBCVI + 1 H1900590 C***** CHECK VALUES IN IAC1I ARRAY H1900600 IF (IAC1I(2)-3) 7909,8900,7909 H1900610 8900 IF (IAC1I(3)-4) 7909,8901,7909 H1900620 8901 IF (IAC1I(4)-5) 7909,7901,7909 H1900630 7909 MRRVI=2 H1900640 WRITE (NUVI,8904)MRRVI H1900650 C***** ERROR IN CONTINUE IMPLIED TEST H1900660 GO TO 8908 H1900670 C***** WRITE OUT CONTINUE IMPLIED IS SUCCESS H1900680 7901 MRRVI=2 H1900690 WRITE (NUVI,8903)MRRVI H1900700 C***** SUCCESS IN CONTINUE IMPLIED TEST H1900710 C***** ASSIGN TERMINAL TEST *********************************7.1.2.8 H1900720 WRITE (NUVI,9908) H1900730 9908 FORMAT (//2X,12HTEST3 ASSIGN) H1900740 C***** HEADER FOR ASSIGN TEST H1900750 8908 MDCVI = 0 H1900760 ASSIGN 7904 TO JFCVI H1900770 DO 7902 NECVI = 2,5,2 H1900780 MDCVI = MDCVI +1 H1900790 7902 ASSIGN 7903 TO JFCVI H1900800 GO TO JFCVI, (7903,7904,7904) H1900810 C***** AN ERROR IN ASSIGN TEST H1900820 7904 MRRVI=3 H1900830 WRITE (NUVI,8904)MRRVI H1900840 C***** ERROR FOR ASSIGN TEST H1900850 GO TO 8907 H1900860 7903 IF (MDCVI-2) 7904,7905,7904 H1900870 C***** ASSIGN TEST IS SUCCESS H1900880 7905 MRRVI=3 H1900890 WRITE (NUVI,8903)MRRVI H1900900 C***** SUCCESS FOR ASSIGN TEST H1900910 C***** LOGICAL IF TERMINAL TEST******************************7.1.2.8 H1900920 WRITE (NUVI,9905) H1900930 9905 FORMAT (//2X,16HTEST4 LOGICAL IF) H1900940 C***** HEADER FOR LOGICAL IF TEST H1900950 8907 KGCVI = 1 H1900960 LHCVI = 3 H1900970 ASSIGN 7908 TO KCVI H1900980 DO 7906 JCVI = 1,3 H1900990 KGCVI = KGCVI +1 H1901000 7906 IF (KGCVI .EQ. LHCVI) ASSIGN 7907 TO KCVI H1901010 GO TO KCVI, (7908,7907,7908) H1901020 C***** TEST IS SUCCESS H1901030 7907 MRRVI=4 H1901040 WRITE (NUVI,8903)MRRVI H1901050 C***** SUCCESS FOR LOGICAL IF TEST H1901060 GO TO 9902 H1901070 C***** LOGICAL IF IS NOT SUCCESS H1901080 7908 MRRVI=4 H1901090 WRITE (NUVI,8904)MRRVI H1901100 C***** ERROR FOR LOGICAL IF TEST H1901110 9902 CONTINUE H1901120 C***** END OF TEST SEGMENT 190 H1901130 C***** WHEN EXECUTING ONLY SEGMENT 190, THE STOP AND END CARDS H1901140 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1901150 C***** IN COLUMNS 1 AND 2 REMOVED. H1901160 C= STOP H1901170 C= END H1901180 C***********************************************************************H1910010 C***** H1910020 C***** DOLMT - (191) H1910030 C***** H1910040 C***********************************************************************H1910050 C***** GENERAL PURPOSE ASA REF H1910060 C***** TEST DO LOOPS WHERE 7.1.2.8/18H1910070 C***** INITIAL H1910080 C***** TERMINAL H1910090 C***** INCREMENT VALUES H1910100 C***** ARE COMPUTED AND SET AT OBJECT TIME H1910110 C***** RESTRICTIONS OBSERVED H1910120 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1910130 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1910140 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1910150 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1910160 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1910170 C***** DO STATEMENT H1910180 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54H1910190 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01H1910200 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1910210 C***** * CONTROL IS NEVER PASSED INTO RANGE OF DO FROM 7.1.2.8.2/44H1910220 C***** OUTSIDE ITS RANGE H1910230 C***** H1910240 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1910250 C***** H0075640 C***** WHEN EXECUTING ONLY SEGMENT 191, THE FOLLOWING STATEMENT H0075645 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075650 C***** H0075655 C= NUVI = 6 H0075660 C***** H0075665 WRITE (NUVI,1914) H1910260 1914 FORMAT (1H1,1X,27HDOLMT - (191) DO SET LIMITS//2X, H1910270 - 18HASA REF. - 7.1.2.8//2X,7HRESULTS) H1910280 C***** HEADER FOR SEGMENT 191 WRITTEN H1910290 JACVI = 1 H1910300 KBCVI = 3 H1910310 LCCVI = 1 H1910320 NECVI = 0 H1910330 DO 1911 MDCVI = JACVI, KBCVI, LCCVI H1910340 NECVI = NECVI + JACVI + KBCVI + MDCVI + LCCVI H1910350 1911 CONTINUE H1910360 IF (NECVI-21) 1913,1912,1913 H1910370 C***** ERROR H1910380 1913 WRITE (NUVI,1915) H1910390 1915 FORMAT (/2X,24H**TEST INDICATES ERROR**//2X,10H**********) H1910400 C***** DOLMT TEST FAILS,LIMIT VALUE SET INCORRECTLY H1910410 GO TO 1917 H1910420 C***** CORRECT H1910430 1912 WRITE (NUVI,1916) H1910440 1916 FORMAT (/2X,19H**TEST SUCCESSFUL**) H1910450 C***** DOLMT TEST IS SUCCESSFUL H1910460 1917 CONTINUE H1910470 C***** END OF TEST SEGMENT 191 H1910480 C***** WHEN EXECUTING ONLY SEGMENT 191, THE STOP AND END CARDS H1910490 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1910500 C***** IN COLUMNS 1 AND 2 REMOVED. H1910510 C= STOP H1910520 C= END H1910530 C***********************************************************************H1920010 C***** H1920020 C***** DONSC - (192) H1920030 C***** H1920040 C***********************************************************************H1920050 C***** GENERAL PURPOSE ASA REF H1920060 C***** TEST NESTED DO LOOPS 7.1.2.8/28H1920070 C***** WITH 2, 3, 4, 5 LEVELS H1920080 C***** SPECIAL CONSIDERATION H1920090 C***** 5 LEVELS ARBITRARILY ASSIGNED AS MINIMUM REQUIREMENT H1920100 C***** RESTRICTIONS OBSERVED H1920110 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1920120 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1920130 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1920140 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1920150 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1920160 C***** DO STATEMENT H1920170 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54H1920180 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01H1920190 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1920200 C***** H1920210 C***** S P E C I F I C A T I O N S SEGMENT 192 H1920220 C***** H0015715 C***** WHEN EXECUTING ONLY SEGMENT 192, THE SPECIFICATION STATEMENTS H0015720 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0015725 C***** IN COLUMNS 1 AND 2 REMOVED. H0015730 C***** H0015735 C= INTEGER MCA3I(2,3,3) H0015740 C***** H0015745 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1920230 C***** H0075670 C***** WHEN EXECUTING ONLY SEGMENT 192, THE FOLLOWING STATEMENT H0075675 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075680 C***** H0075685 C= NUVI = 6 H0075690 C***** H0075695 WRITE (NUVI,8920) H1920240 8920 FORMAT (1H1,1X,26HDONSC - (192) NESTED LOOPS// 2X, H1920250 -18HASA REF. - 7.1.2.8//2X,7HRESULTS) H1920260 C***** HEADER FOR SEGMENT 192 WRITTEN H1920270 C***** TWO LEVELS OF NESTING*****************************************H1920280 MRRVI=2 H1920290 WRITE (NUVI,8921)MRRVI H1920300 8921 FORMAT (//2X,I1,1X,17HLEVELS OF NESTING) H1920310 C***** HEADER FOR TWO LEVELS H1920320 JACVI = 0 H1920330 DO 1922 KBCVI = 1, 2, 1 H1920340 JACVI = KBCVI*3 + JACVI H1920350 DO 1921 LCCVI = 1,5, 2 H1920360 JACVI = JACVI + LCCVI H1920370 1921 CONTINUE H1920380 1922 CONTINUE H1920390 C***** TEST JACVI FOR VALUE OF 27 H1920400 IF (JACVI-27) 1924,1923,1924 H1920410 C***** CORRECT H1920420 1923 WRITE (NUVI,8922) H1920430 8922 FORMAT (2X,19H**TEST SUCCESSFUL**) H1920440 C***** TWO LEVELS OF NESTING IS CORRECT H1920450 GO TO 7927 H1920460 C***** ERROR H1920470 1924 WRITE (NUVI,8923) H1920480 8923 FORMAT (2X,24H**TEST INDICATES ERROR**) H1920490 C***** TWO LEVELS OF NESTING IN ERROR H1920500 C***** THREE LEVELS OF NESTING***************************************H1920510 7927 MRRVI=3 H1920520 WRITE (NUVI,8921)MRRVI H1920530 C***** HEADER FOR THREE LEVELS H1920540 MDCVI = 0 H1920550 DO 1927 LCCVI = 6,7 H1920560 DO 1926 KBCVI = 8,10,2 H1920570 DO 1925 JACVI = 1,3,1 H1920580 MDCVI = MDCVI + JACVI + KBCVI + LCCVI H1920590 1925 CONTINUE H1920600 1926 CONTINUE H1920610 1927 CONTINUE H1920620 C***** TEST MDCVI FOR VALUE OF 210 H1920630 IF (MDCVI - 210) 1928,1929,1928 H1920640 C***** ERROR H1920650 1928 WRITE (NUVI,8923) H1920660 C***** THREE LEVELS OF NESTING IN ERROR H1920670 GO TO 7928 H1920680 C***** CORRECT H1920690 1929 WRITE (NUVI,8922) H1920700 C***** THREE LEVELS OF NESTING IS CORRECT H1920710 C***** FOUR LEVELS OF NESTING****************************************H1920720 7928 MRRVI=4 H1920730 WRITE (NUVI,8921)MRRVI H1920740 C***** HEADER FOR FOUR LEVELS H1920750 IHDVI = 0 H1920760 IGDVI = 0 H1920770 IFDVI = 0 H1920780 IEDVI = 0 H1920790 ICVI = 1 H1920800 DO 7920 MDCVI = 2,3 H1920810 IHDVI = IHDVI + MDCVI + IEDVI H1920820 DO 7920 LCCVI = 3,5,3 H1920830 IGDVI = IGDVI + LCCVI + IHDVI H1920840 DO 7920 KBCVI = 1,2,ICVI H1920850 IFDVI = IFDVI + KBCVI + IGDVI H1920860 DO 7920 JACVI = 4,5,2 H1920870 IEDVI = IEDVI + JACVI + IFDVI H1920880 7920 CONTINUE H1920890 C***** TEST IEDVI FOR VALUE OF 185 H1920900 IF (IEDVI - 185) 7921,7922,7921 H1920910 C***** ERROR H1920920 7921 WRITE (NUVI,8923) H1920930 C***** FOUR LEVELS OF NESTING IN ERROR H1920940 GO TO 7929 H1920950 C***** CORRECT H1920960 7922 WRITE (NUVI,8922) H1920970 C***** FOUR LEVELS OF NESTING IS CORRECT H1920980 C***** FIVE LEVELS OF NESTING****************************************H1920990 7929 MRRVI=5 H1921000 WRITE (NUVI,8921)MRRVI H1921010 C***** HEADER FOR FIVE LEVELS H1921020 IGDVI = 0 H1921030 DO 7923 NECVI = 10,11,1 H1921040 DO 7923 MDCVI = 4,5,1 H1921050 DO 7924 LCCVI = 1,2,3 H1921060 DO 7924 KBCVI = 6, 8, 4 H1921070 DO 7924 JACVI = 1,3,2 H1921080 IGDVI=IGDVI+JACVI-KBCVI+LCCVI-MDCVI+NECVI H1921090 7924 CONTINUE H1921100 7923 CONTINUE H1921110 C***** TEST IGDVI FOR VALUE OF 24 H1921120 IF (IGDVI - 24) 7925, 7926,7925 H1921130 C***** ERROR H1921140 7925 WRITE (NUVI,8923) H1921150 C***** FIVE LEVELS IN ERROR H1921160 GO TO 9923 H1921170 7926 WRITE (NUVI,8922) H1921180 C***** FIVE LEVELS CORRECT H1921190 C***** CONTROL VARIABLES FOR 3 DO LOOPS USED IN SUBSCRIPT EXPRESSIONS H1921200 C***** FOR A 3 DIMENSIONAL ARRAY H1921210 9923 WRITE(NUVI, 9920) H1921220 9920 FORMAT(//2X,34HCONTROL VARIABLE USED IN SUBSCRIPT ) H1921230 IVI = 1 H1921240 KVI = 0 H1921250 8924 KVI = KVI + 1 H1921260 JVI = 0 H1921270 8925 JVI = JVI + 1 H1921280 MCA3I(IVI,JVI,KVI) = IVI + 2*(JVI-1)+ 6*(KVI-1) H1921290 MCA3I(IVI+1,JVI,KVI) = IVI+1 +2*(JVI-1)+6*(KVI-1) H1921300 IF(JVI-3) 8925,8926,8929 H1921310 8926 IF(KVI-3)8924,8927,8929 H1921320 8927 IIVI = 1 H1921330 DO 8928 KVI =1,3 H1921340 DO 8928 JVI = 1,3 H1921350 DO 8928 IVI = 1,2 H1921360 IAVI =MCA3I(IVI,JVI,KVI) - IIVI H1921370 IF (IAVI) 8929, 8928, 8929 H1921380 8928 IIVI = IIVI + 1 H1921390 WRITE (NUVI,8922) H1921400 GO TO 9921 H1921410 8929 WRITE (NUVI,8923) H1921420 9921 CONTINUE H1921430 C***** END OF TEST SEGMENT 192 H1921440 C***** WHEN EXECUTING ONLY SEGMENT 192, THE STOP AND END CARDS H1921450 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1921460 C***** IN COLUMNS 1 AND 2 REMOVED. H1921470 C= STOP H1921480 C= END H1921490 C***********************************************************************H1930010 C***** H1930020 C***** DONSI - (193) H1930030 C***** H1930040 C***********************************************************************H1930050 C***** GENERAL PURPOSE ASA REF H1930060 C***** TESTS INCOMPLETE DO LOOP 7.1.2.8.1/19H1930070 C***** RESTRICTIONS OBSERVED H1930080 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1930090 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1930100 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1930110 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1930120 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1930130 C***** DO STATEMENT H1930140 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.1/54H1930150 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.1/01H1930160 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1930170 C***** H1930180 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1930190 C***** H0075700 C***** WHEN EXECUTING ONLY SEGMENT 193, THE FOLLOWING STATEMENT H0075705 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075710 C***** H0075715 C= NUVI = 6 H0075720 C***** H0075725 WRITE (NUVI,1935) H1930200 1935 FORMAT (1H1,1X,27HDONSI - (193) INCOMPLETE DO//2X, H1930210 - 18HASA REF. - 7.1.2.8//2X,7HRESULTS) H1930220 C***** HEADER FOR SEGMENT 193 WRITTEN H1930230 KBCVI = 0 H1930240 DO 1931 JACVI = 1,5,1 H1930250 KBCVI = KBCVI + JACVI H1930260 IF(KBCVI - 6) 1931, 1930, 1931 H1930270 1930 GO TO 1932 H1930280 1931 CONTINUE H1930290 C***** ERROR EXIT H1930300 WRITE (NUVI,1936) H1930310 1936 FORMAT (1H0,2X,28H**INCOMPLETE LOOP IN ERROR**) H1930320 C***** INCOMPLETE LOOP TEST IN ERROR H1930330 GO TO 1937 H1930340 C***** TEST JACVI FOR VALUE OF 3 7.1.2.8.1/21H1930350 1932 IF (JACVI - 3) 1933,1934,1933 H1930360 C***** ERROR IN INDUCTION VARIABLE H1930370 1933 WRITE (NUVI,1938) H1930380 1938 FORMAT (1H0,2X,31H**INDUCTION VARIABLE IN ERROR**) H1930390 C***** INDUCTION VARIABLE SET INCORRECTLY OUTSIDE LOOP H1930400 GO TO 1937 H1930410 1934 WRITE (NUVI,1939) H1930420 1939 FORMAT (1H0,1X,30H**INCOMPLETE LOOP SUCCESSFUL**) H1930430 C***** INCOMPLETE LOOP TEST SUCCESS H1930440 1937 CONTINUE H1930450 C***** END OF TEST SEGMENT 193 H1930460 C***** WHEN EXECUTING ONLY SEGMENT 193, THE STOP AND END CARDS H1930470 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1930480 C***** IN COLUMNS 1 AND 2 REMOVED. H1930490 C= STOP H1930500 C= END H1930510 C***********************************************************************H1940010 C***** H1940020 C***** DONSX - (194) H1940030 C***** H1940040 C***********************************************************************H1940050 C***** GENERAL PURPOSE ASA REF H1940060 C***** TESTS EXTENDED RANGE OF DO LOOP VARIABLE 7.1.2.8.2H1940070 C***** RESTRICTIONS OBSERVED H1940080 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1940090 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1940100 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1940110 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1940120 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1940130 C***** DO STATEMENT H1940140 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54H1940150 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01H1940160 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1940170 C***** * THE EXTENDED RANGE OF A DO DOES NOT CONTAIN A 7.1.2.8.2/48H1940180 C***** DO OF THE SAME PROGRAM UNIT THAT HAS AN H1940190 C***** EXTENDED RANGE. H1940200 C***** H1940210 C***** S P E C I F I C A T I O N S SEGMENT 194 H1940220 C***** H0015750 C***** WHEN EXECUTING ONLY SEGMENT 194, THE SPECIFICATION STATEMENTS H0015755 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0015760 C***** IN COLUMNS 1 AND 2 REMOVED. H0015765 C***** H0015770 C= DIMENSION IAC1I(5) H0015775 C= INTEGER I3I(2,2,2) H0015780 C***** H0015785 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1940230 C***** H0075730 C***** WHEN EXECUTING ONLY SEGMENT 194, THE FOLLOWING STATEMENT H0075735 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075740 C***** H0075745 C= NUVI = 6 H0075750 C***** H0075755 WRITE (NUVI,8944) H1940240 8944 FORMAT (1H1,1X,31HDONSX - (194) EXTENDED DO RANGE//2X, H1940250 120HASA REF. - 7.1.2.8.2//2X,7HRESULTS) H1940260 C***** HEADER FOR SEGMENT 194 WRITTEN H1940270 C***** EXTENDED RANGE FROM SINGLE LEVEL******************************H1940280 MRRVI=1 H1940290 WRITE (NUVI,8942)MRRVI H1940300 8942 FORMAT (//2X,26HEXTENDED RANGE FROM LEVEL ,I1) H1940310 C***** HEADER FOR SINGLE LEVEL WRITTEN H1940320 DO 1941 JACVI = 1,4,2 H1940330 IAC1I(JACVI) = JACVI H1940340 GO TO 1942 H1940350 1943 IF(JACVI-1) 1945,1941,1945 H1940360 1941 CONTINUE H1940370 GO TO 1949 H1940380 C***** TEST JACVI FOR VALUE OF 1 H1940390 1942 IF (JACVI - 1) 1946,1943,1946 H1940400 C***** TEST IAC1I(1) AND IAC1I(3) FOR VALUES OF 1 AND 3 H1940410 1946 IF (IAC1I(1)-1) 1947,7946,1947 H1940420 7946 IF (IAC1I(3)-3) 1947,1943,1947 H1940430 C***** ERROR H1940440 1947 WRITE (NUVI,7947) H1940450 7947 FORMAT (/2X,24H**TEST INDICATES ERROR**) H1940460 C***** ERROR IN SETTING OF IAC1I ARRAY, LOOP NOT WORKING H1940470 GO TO 8940 H1940480 C***** TEST JACVI FOR VALUE OF 3 H1940490 1945 IF (JACVI - 3) 1948,1941,1948 H1940500 C***** ERROR H1940510 1948 WRITE (NUVI,7947) H1940520 C***** ERROR IN SETTING OF INDUCTION VARIABLE H1940530 GO TO 8940 H1940540 1949 WRITE (NUVI,7949) H1940550 7949 FORMAT (/2X,19H**TEST SUCCESSFUL**) H1940560 C***** EXTENDED RANGE SUCCESS FOR SINGLE LEVEL H1940570 8940 MRRVI=2 H1940580 C***** EXTENDED RANGE FROM DOUBLE LEVEL******************************H1940590 WRITE (NUVI,8942)MRRVI H1940600 C***** HEADER FOR DOUBLE LEVEL WRITTEN H1940610 DO 7940 KBCVI = 3,4 H1940620 DO 7940 JACVI = 1,2,3 H1940630 GO TO 7941 H1940640 8947 IGDVI= 1 H1940650 7940 CONTINUE H1940660 C***** TEST JACVI FOR VALUE OF 1 H1940670 7941 IF (JACVI-1) 7942,7943,7942 H1940680 C***** ERROR H1940690 7942 WRITE (NUVI,7947) H1940700 C***** DOUBLE LEVEL NESTING IN ERROR H1940710 GO TO 8946 H1940720 C***** TEST KBCVI FOR VALUE OF 3 OR 4 H1940730 7943 IF (KBCVI-3) 7942,8947,7944 H1940740 7944 IF (KBCVI-4) 7942,7945,7942 H1940750 C***** CORRECT H1940760 7945 WRITE (NUVI,7949) H1940770 C***** DOUBLE LEVEL TEST CORRECT H1940780 8946 CONTINUE H1940790 I3I(1,1,1) = 2 H1940800 I3I(2,1,1) = 4 H1940810 I3I(1,2,1) = 1 H1940820 I3I(2,2,1) = 2 H1940830 I3I(1,1,2)= -2 H1940840 I3I(2,1,2) = 0 H1940850 I3I(1,2,2) = -3 H1940860 I3I(2,2,2) = -2 H1940870 8952 FORMAT(//2X,40HEXTENDED RANGE CONTAINING A DO STATEMENT) H1940880 WRITE(NUVI, 8952) H1940890 DO 8948 IVI = 1,2 H1940900 I3I(1,1,IVI) = I3I(1,1,IVI) + 1 H1940910 DO 8948 JVI = 1,2 H1940920 I3I(1,JVI,IVI) = I3I(1,JVI,IVI) + 2 H1940930 GO TO 8949 H1940940 8951 CONTINUE H1940950 8948 CONTINUE H1940960 WRITE (NUVI, 8950) I3I H1940970 8950 FORMAT(8(/I5) /30H THE ABOVE 8 VALUES SHOULD BE/ H1940980 1 33H IN DESCENDING ORDER FROM 8 TO 1) H1940990 GO TO 8953 H1941000 8949 DO 8954 KVI = 1,2 H1941010 I3I(KVI,JVI,IVI) = I3I(KVI,JVI,IVI) + 3 H1941020 8954 CONTINUE H1941030 GO TO 8951 H1941040 8953 CONTINUE H1941050 C***** END OF TEST SEGMENT 194 H1941060 C***** WHEN EXECUTING ONLY SEGMENT 194, THE STOP AND END CARDS H1941070 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1941080 C***** IN COLUMNS 1 AND 2 REMOVED. H1941090 C= STOP H1941100 C= END H1941110 C***********************************************************************H1950010 C***** H1950020 C***** DONML - (195) H1950030 C***** H1950040 C***********************************************************************H1950050 C***** GENERAL PURPOSE ASA REF H1950060 C***** TESTS TWO INDEPENDENT LOOPS NESTED 7.1.2.8/28H1950070 C***** WITHIN LARGER ONE H1950080 C***** RESTRICTIONS OBSERVED H1950090 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1950100 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1950110 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1950120 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1950130 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1950140 C***** DO STATEMENT H1950150 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.1/54H1950160 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.1/01H1950170 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1950180 C***** H1950190 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1950200 C***** H0075760 C***** WHEN EXECUTING ONLY SEGMENT 195, THE FOLLOWING STATEMENT H0075765 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075770 C***** H0075775 C= NUVI = 6 H0075780 C***** H0075785 WRITE (NUVI,1950) H1950210 1950 FORMAT (1H1,1X,30HDONML - (195) MULT-LEVEL LOOPS//2X, H1950220 - 18HASA REF. - 7.1.2.8//2X,7HRESULTS) H1950230 C***** HEADER FOR SEGMENT 195 WRITTEN H1950240 IHDVI = 1 H1950250 IGDVI = 2 H1950260 IFDVI = 3 H1950270 DO 1951 JACVI = 1,2 H1950280 IFDVI = IFDVI + JACVI H1950290 DO 1952 KBCVI = 2,4,1 H1950300 IGDVI = IGDVI + 1 H1950310 1952 CONTINUE H1950320 IFDVI = IFDVI + IGDVI H1950330 DO 1953 LCCVI = 6,7,3 H1950340 IHDVI = 1 + IHDVI H1950350 1953 CONTINUE H1950360 IFDVI = IFDVI + IHDVI H1950370 1951 CONTINUE H1950380 C***** TEST IFDVI FOR VALUE OF 24 H1950390 IF (IFDVI - 24) 1954,1955,1954 H1950400 C***** ERROR H1950410 1954 WRITE (NUVI,1956) H1950420 1956 FORMAT (/2X,24H**TEST INDICATES ERROR**) H1950430 C***** MULTI-LEVEL TEST IN ERROR H1950440 GO TO 1958 H1950450 C***** CORRECT H1950460 1955 WRITE (NUVI,1957) H1950470 1957 FORMAT (/2X,19H**TEST SUCCESSFUL**) H1950480 C***** MULTI-LEVEL TEST CORRECT H1950490 1958 CONTINUE H1950500 C***** END OF TEST SEGMENT 195 H1950510 C***** WHEN EXECUTING ONLY SEGMENT 195, THE STOP AND END CARDS H1950520 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1950530 C***** IN COLUMNS 1 AND 2 REMOVED. H1950540 C= STOP H1950550 C= END H1950560 C***********************************************************************H1960010 C***** H1960020 C***** DONIO - (196) H1960030 C***** H1960040 C***********************************************************************H1960050 C***** GENERAL PURPOSE ASA REF H1960060 C***** TO TEST DO LOOPS WHICH HAVE I/O TERMINAL 7.1.2.8 H1960070 C***** STATEMENTS (FORMATTED READ, FORMATTED WRITE 7.1.3.2.2H1960080 C***** AND REWIND ARE USED AS TERMINAL STATEMENTS) 7.1.3.2.3H1960090 C***** 7.1.3.3.1H1960100 C***** RESTRICTIONS OBSERVED H1960110 C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21H1960120 C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08H1960130 C***** THE DO AND IS IN THE SAME PROGRAM UNIT H1960140 C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07H1960150 C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10H1960160 C***** DO STATEMENT H1960170 C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54H1960180 C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01H1960190 C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST H1960200 C***** H1960210 C***** S P E C I F I C A T I O N S SEGMENT 196 H1960220 C***** H0015790 C***** WHEN EXECUTING ONLY SEGMENT 196, THE SPECIFICATION STATEMENTS H0015795 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0015800 C***** IN COLUMNS 1 AND 2 REMOVED. H0015805 C***** H0015810 C= DIMENSION IAC1I(5),AC2S(5,6) H0015815 C= LOGICAL MCAVB,MCBVB,GH2B(1,2) H0015820 C= DOUBLE PRECISION CC3D(7,2,2),DPAVD,DPBVD H0015825 C= COMPLEX NUMVC,DENVC,LL1C(32) H0015830 C***** H0015835 C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE. H1960230 C***** H0075790 C***** WHEN EXECUTING ONLY SEGMENT 196, THE FOLLOWING STATEMENTS H0075795 C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075800 C***** H0075805 C= NUVI = 6 H0075810 C= INVI = 9 H0075815 C***** H0075820 WRITE (NUVI,1960) H1960240 1960 FORMAT (1H1,1X,31HDONIO - (196) DO LOOPS WITH I/O/16X, H1960250 119HTERMINAL STATEMENTS/ 20H ASA REF. - 7.1.2.8/ 9H RESULTS) H1960260 C***** HEADER FOR SEGMENT 196 WRITTEN H1960270 KCAVI = 1 H1960280 CKAVS = 1.0 H1960290 DPBVD = 1.0D0 H1960300 DENVC = (1.0,1.0) H1960310 MCBVB = .TRUE. H1960320 IAC1I(2) = 1 H1960330 AC2S(4,3) = 1. H1960340 CC3D(5,1,2) = 1.0D0 H1960350 LL1C(2) = (1.0,1.0) H1960360 GH2B(1,1) = .TRUE. H1960370 WRITE (INVI,1965) KCAVI, CKAVS, DPBVD, DENVC, MCBVB, IAC1I(2), H1960380 1 AC2S(4,3), CC3D(5,1,2), LL1C(2), GH2B(1,1) H1960390 REWIND INVI H1960400 DO 1964 JACVI = 1,3,1 H1960410 C***** H1960420 DO 1961 KBCVI = 1,1,1 H1960430 1961 READ (INVI,1965) MCAVI,CMAVS,DPAVD,NUMVC,MCAVB,IAC1I(KBCVI), H1960440 1 AC2S(5,4), CC3D(6,1,2), LL1C(3), GH2B(KBCVI,2) H1960450 C***** H1960460 DO 1962 LCCVI = 1,2,1 H1960470 1962 REWIND INVI H1960480 C***** H1960490 DO 1963 MDCVI = 1,1,1 H1960500 1963 WRITE (NUVI,1966) MCAVI, IAC1I(1), CMAVS, AC2S(5,4), DPAVD, H1960510 1 CC3D(6,1,2), NUMVC, LL1C(3), MCAVB, H1960520 2 GH2B(MDCVI, MDCVI+1) H1960530 1964 CONTINUE H1960540 WRITE (NUVI,1967) H1960550 C***** FORMAT STATEMENTS FOR THIS SEGMENT H1960560 1965 FORMAT (2(I5,F5.1,D8.1,2(F5.1),L5)) H1960570 1966 FORMAT ( // 2(I10/),2(F11.1/),2(D15.1/),2(F5.1,F6.1/),2(L10/)) H1960580 1967 FORMAT (//30H THIS TEST IS SUCCESSFUL IF 3/38H IDENTICAL GROUPH1960590 1S OF OUTPUT HAVE BEEN/12H GENERATED.) H1960600 C***** END OF SEGMENT 196 H1960610 C***** WHEN EXECUTING ONLY SEGMENT 196, THE STOP AND END CARDS H1960620 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1960630 C***** IN COLUMNS 1 AND 2 REMOVED. H1960640 C= STOP H1960650 C= END H1960660 C***********************************************************************H1970010 C***** H1970020 C***** MORDO - (197) H1970030 C***** H1970040 C***********************************************************************H1970050 C***** GENERAL PURPOSE ASA REF H1970060 C***** A MORE COMPLICATED SEGMENT TESTING THE DO STATEMENT 7.1.2.8H1970070 C***** H1970080 C***** S P E C I F I C A T I O N S SEGMENT 197 H1970090 C***** H0015840 C***** WHEN EXECUTING ONLY SEGMENT 197 THE SPECIFICATION STATEMENTS H0015845 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0015850 C***** IN COLUMNS 1 AND 2 REMOVED. H0015855 C***** H0015860 C= DIMENSION IAC1I(5), MCA1I(5) H0015865 C***** H0015870 C***** WHEN EXECUTING ONLY SEGMENT 197, THE SEGMENT 005, WHICH H1970100 C***** CONTAINS THE STATEMENT FUNCTIONS BEING USED HERE, MUST BE H1970110 C***** INSERTED AFTER THE SPECIFICATION STATEMENTS OF SEGMENT 197. H1970120 C***** H1970130 C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE. H1970140 C***** H0075825 C***** WHEN EXECUTING ONLY SEGMENT 197, THE FOLLOWING STATEMENTS H0075830 C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075835 C***** H0075840 C= NUVI = 6 H0075845 C= INVI = 9 H0075850 C***** H0075855 WRITE (NUVI,1970) H1970150 1970 FORMAT (1H1, 1X,37HMORDO - (197) A MORE COMPLICATED SEG./16X, H1970160 1 16HOF DO STATEMENTS// H1970170 2 35H ASA REFS - 7.1.2.8 AND 7.1.2.8.1 // 9H RESULTS ) H1970180 C***** HEADER FOR SEGMENT 197 WRITTEN H1970190 C***** TEST OF DO WITH STATEMENT FUNCTIONS AND INTRINSIC FUNCTIONS H1970200 C***** REFERENCED WITHIN ITS RANGE. TO BE RUN WITH SEG. 005 AND 412 H1970210 ASSIGN 9190 TO MVI H1970220 MCBVI = 0 H1970230 MCHVI = 1971 H1970240 DO 1971 MCAVI = 4,8,4 H1970250 CMAVS = CMAFS(1.0, FLOAT(MCAVI)) H1970260 1971 MCBVI = MCBVI + MCAFI(MCAVI,IFIX(CMAVS) - (MCAVI+2)) H1970270 IF (MCBVI - 2) 9966, 9190, 9966 H1970280 9190 MCHVI = 1973 H1970290 C***** TEST OF DO WITH CALL STATEMENTS REFERENCED WITHIN ITS RANGE H1970300 IVI = 0 H1970310 ASSIGN 9968 TO MVI H1970320 DO 1973 MCAVI = 1,3 H1970330 1973 CALL MDQ( MCAVI, IVI) H1970340 IF(IVI - 6) 9966, 9968, 9966 H1970350 C***** TEST OF DO WITH THE FOLLOWING FEATURES COMBINED - H1970360 C***** 1. AN EXIT FROM THE RANGE OF A DO BY THE EXECUTION OF A H1970370 C***** GO-TO STATEMENT, THE CONTROL VARIABLE OF THE DO IS H1970380 C***** DEFINED 7.1.2.8.1/19-23H1970390 C***** 2. A GO TO STATEMENT CAUSES CONTROL TO PASS FROM AN H1970400 C***** INNER DO TO THE OUTER DO (WITHIN THE NESTED RANGE) H1970410 9968 MCHVI = 1976 H1970420 ASSIGN 9191 TO MVI H1970430 MCBVI = 0 H1970440 DO 1976 MCAVI = 1,1,1 H1970450 9192 MCBVI = MCBVI + 1 H1970460 DO 1975 MCCVI = 1,3,1 H1970470 MCBVI = MCBVI + 1 H1970480 IF(MCBVI - 4) 9197, 9192, 1975 H1970490 9197 GO TO (1975, 1975, 9966), MCCVI H1970500 1975 CONTINUE H1970510 1976 CONTINUE H1970520 IF (MCBVI - 8) 9966, 9191, 9966 H1970530 C***** TEST THAT THE STATEMENT LABEL OF THE TERMINAL STATEMENT H1970540 C***** OF MORE THAN ONE DO CAN BE USED IN ANY GO TO OR ARITHMETIC H1970550 C***** IF STATEMENT THAT OCCURS IN THE RANGE OF THE MOST DEEPLY H1970560 C***** CONTAINED DO WITH THAT TERMINAL STATEMENT. 7.1.2.8.2/1-6 H1970570 C***** ALSO THE CONTROL VARIABLE IS DEFINED WHEN EXIT IS MADE BY THE H1970580 C***** EXECUTION OF AN ARITHMETIC IF STATEMENT. H1970590 9191 ASSIGN 9194 TO MVI H1970600 MCHVI = 1977 H1970610 MCEVI = -24 H1970620 DO 1977 MCAVI = 1,2 H1970630 MCEVI = MCEVI + 1 H1970640 DO 1977 MCBVI = 1,2 H1970650 MCEVI = MCEVI + 1 H1970660 DO 1977 MCCVI = 1,5,1 H1970670 MCEVI = MCEVI + 1 H1970680 IF(MCEVI ) 1977, 1977, 1978 H1970690 1977 CONTINUE H1970700 C***** ERROR IF LOOP TERMINATES THRU CONTINUE H1970710 GO TO 9966 H1970720 C***** CONTROL VARIABLE DEFINED ON FIRST LEVEL ON ARITH. IF H1970730 1978 MCEVI = MCAVI + MCBVI + MCCVI H1970740 MCHVI = 1978 H1970750 IF(MCEVI -8) 9966,9194,9966 H1970760 9194 MCHVI = 1974 H1970770 MCEVI = 0 H1970780 ASSIGN 9961 TO MVI H1970790 DO 1974 MCAVI = 1,2 H1970800 DO 1974 MCBVI = 1,2,1 H1970810 DO 1974 MCCVI = 4,5,1 H1970820 DO 1974 MCDVI = 2,3 H1970830 GO TO 9193 H1970840 9195 GO TO 1974 H1970850 9193 MCEVI = MCAVI + MCBVI + MCCVI + MCDVI + MCEVI H1970860 GO TO 9195 H1970870 1974 CONTINUE H1970880 IF(MCEVI - 160) 9966, 9961, 9966 H1970890 C***** TEST OF DO WITH I/O STATEMENTS REFERENCED WITHIN ITS RANGE. H1970900 C***** REWIND, UNFORMATTED READ AND WRITE ARE REFERENCED. THE H1970910 C***** FOLLOWING 3 DOS MUST BE KEPT TOGETHER FOR SELF-CHECKING H1970920 C***** PURPOSES H1970930 9961 MCHVI = 1972 H1970940 ASSIGN 9196 TO MVI H1970950 REWIND INVI H1970960 DO 9963 MCAVI = 1,4 H1970970 MCA1I(MCAVI) = MCAVI H1970980 WRITE ( INVI) (MCA1I(MCBVI), MCBVI = 1,MCAVI, 1) H1970990 9963 CONTINUE H1971000 DO 9964 MCCVI = 1,4 H1971010 9964 REWIND INVI H1971020 DO 1972 MCDVI = 1,4 H1971030 READ (INVI) (IAC1I(MCEVI),MCEVI = 1,MCDVI) H1971040 DO 1972 MCFVI = 1, MCDVI H1971050 MCGVI = IAC1I(MCFVI) - MCA1I(MCFVI) H1971060 IF (MCGVI) 9966, 1972, 9966 H1971070 1972 CONTINUE H1971080 9196 WRITE(NUVI, 9969) H1971090 GO TO 9198 H1971100 C***** ERROR MESSAGES IF DO STATEMENT IS EXECUTED IN ERROR. H1971110 9966 WRITE (NUVI,9967) MCHVI H1971120 9967 FORMAT (// 36H DO RANGE ENDING AT STATEMENT LABEL,I5, H1971130 114H IS IN ERROR.) H1971140 9969 FORMAT(// 35H THIS SEGMENT SUCCESSFULLY TESTED / H1971150 222H IF NO ERROR MESSAGES) H1971160 GO TO MVI,(9190,9968,9191,9194,9961,9196) H1971170 9198 REWIND INVI H1971180 C***** END OF TEST SEGMENT 197 H1971190 C***** WHEN EXECUTING ONLY SEGMENT 197, THE STOP AND END CARDS H1971200 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1971210 C***** IN COLUMNS 1 AND 2 REMOVED. H1971220 C= STOP H1971230 C= END H1971240 C***********************************************************************H2000010 C***** H2000020 C***** SUBR1 - (200) H2000030 C***** H2000040 C***********************************************************************H2000050 C***** GENERAL PURPOSE ASA REF.H2000060 C***** TO TEST SUBROUTINE SUBPROGRAM WITHOUT AN ARGUMENT LIST 8.4.1.1H2000070 C***** GENERAL COMMENTS H2000080 C***** IT IS TO BE RUN WITH SEGMENT 410 H2000090 C***** RESTRICTIONS OBSERVED H2000100 C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.1/56H2000110 C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE H2000120 C***** SUBROUTINE STATEMENT ITSELF H2000130 C***** * SYMBOLIC NAMES OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/39H2000140 C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM H2000150 C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.1/45H2000160 C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT H2000170 C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE H2000180 C***** BEING DEFINED H2000190 C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE H2000200 C***** 8.4.1.1/49H2000210 C***** S P E C I F I C A T I O N S SEGMENT 200 H2000220 C***** H0015875 C***** WHEN EXECUTING ONLY SEGMENT 200, THE SPECIFICATION STATEMENTS H0015880 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0015885 C***** IN COLUMNS 1 AND 2 REMOVED. H0015890 C= COMMON AXVS, CXVS, IXVI, IAX1I(4) H0015895 C***** H0015900 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H2000230 C***** WHEN EXECUTING ONLY SEGMENT 200, THE FOLLOWING STATEMENTS H0075860 C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075865 C***** H0075870 C= NUVI = 6 H0075875 C= INVI = 9 H0075880 WRITE(NUVI, 0200) H2000240 200 FORMAT(39H1 SUBR1 - (200) SUBROUTINE SUBPROGRAM /15X, H2000250 124HWITHOUT AN ARGUMENT LIST //18H ASA REF. - 8.4.1//9H RESULTS) H2000260 IXVI = NUVI H2000270 IAX1I(1) = INVI H2000280 CALL SUBRQ H2000290 CONTINUE H2000300 C***** END OF SEGMENT 200 H2000310 C***** WHEN EXECUTING ONLY SEGMENT 200, THE STOP AND END CARDS H2000320 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H2000330 C***** IN COLUMNS 1 AND 2 REMOVED. H2000340 C= STOP H2000350 C= END H2000360 STOP H9999995 END H9999999 C***********************************************************************H4100010 C***** H4100020 C***** SUBRQ - (410) H4100030 C***** H4100040 C***********************************************************************H4100050 C***** THIS SEGMENT TESTS THAT A VARIETY OF FORTRAN STATEMENTS H4100060 C***** CAN BE USED IN A SUBROUTINE. IT IS TO BE RUN WITH SEGMENT 200 H4100070 SUBROUTINE SUBRQ H4100080 8867 FORMAT (//36H DO RANGE ENDING AT STATEMENT LABEL,I5,14H IS IN ERH4100090 1ROR.) H4100100 DIMENSION KCA1I(5), KAC1I(5) H4100110 COMMON BXVS, DXVS, NXVI, IXVI H4100120 C***** DEFINE ARITHMETIC STATEMENT FUNCTION H4100130 CKAFS(CEWVS,CFWVS) = CEWVS*2. + CFWVS H4100140 8868 FORMAT (//35H THIS SEGMENT SUCCESSFULLY TESTED / H4100150 1 23H IF NO ERROR MESSAGES.) H4100160 KCAFI(KEWVI,KFWVI) = KEWVI**KFWVI H4100170 C***** TEST OF DO WITH STATEMENT FUNCTIONS H4100180 KCHVI = 4101 H4100190 ASSIGN 4102 TO MVI H4100200 KCBVI = 0 H4100210 DO 4101 KCAVI = 4,8,4 H4100220 CKAVS = CKAFS(1.0, FLOAT(KCAVI)) H4100230 4101 KCBVI = KCBVI + KCAFI(KCAVI,IFIX(CKAVS) - (KCAVI + 2)) H4100240 IF(KCBVI - 2) 8866, 4102, 8866 H4100250 C***** TEST OF DO WITH THE FOLLOWING FEATURES COMBINED - H4100260 C***** 1. AN EXIT FROM THE RANGE OF A DO BY THE EXECUTION OF A H4100270 C***** GO-TO STATEMENT, THE CONTROL VARIABLE OF THE DO IS H4100280 C***** DEFINED H4100290 C***** 2. A GO TO STATEMENT CAUSES CONTROL TO PASS FROM AN H4100300 C***** INNER DO TO THE OUTER DO (WITHIN THE NESTED RANGE) H4100310 4102 KCHVI = 4106 H4100320 ASSIGN 8870 TO MVI H4100330 KCBVI = 0 H4100340 DO 4106 KCAVI = 1,1,1 H4100350 8872 KCBVI = KCBVI + 1 H4100360 DO 4105 KCCVI = 1,3,1 H4100370 KCBVI = KCBVI + 1 H4100380 IF (KCBVI - 4) 8873, 8872, 4105 H4100390 8873 GO TO (4105,4105,8866), KCCVI H4100400 4105 CONTINUE H4100410 4106 CONTINUE H4100420 IF(KCBVI - 8) 8866, 8870, 8866 H4100430 C***** TEST THAT THE STATEMENT LABEL OF THE TERMINAL STATEMENT H4100440 C***** OF MORE THAN ONE DO CAN BE USED IN ANY GO TO OR ARITHMETIC H4100450 C***** IF STATEMENT THAT OCCURS IN THE RANGE OF THE MOST DEEPLY H4100460 C***** CONTAINED DO WITH THAT TERMINAL STATEMENT H4100470 8870 ASSIGN 8876 TO MVI H4100480 KCHVI = 4107 H4100490 KCEVI = -24 H4100500 DO 4107 KCAVI = 1,2 H4100510 KCEVI = KCEVI + 1 H4100520 DO 4107 KCBVI = 1,2 H4100530 KCEVI = KCEVI + 1 H4100540 DO 4107 KCCVI = 1,5,1 H4100550 KCEVI = KCEVI + 1 H4100560 IF(KCEVI ) 4107,4107,4104 H4100570 4107 CONTINUE H4100580 C*****ERROR IF LOOP TERMINATES THRU CONTINUE H4100590 GO TO 8866 H4100600 C*****CONTROL VARIABLE DEFINED ON FIRST LEVEL ON ARITH. IF H4100610 4104 KCEVI = KCAVI + KCBVI + KCCVI H4100620 KCHVI = 4104 H4100630 IF(KCEVI - 8) 8866,8876,8866 H4100640 8876 KCHVI = 4103 H4100650 KCEVI = 0 H4100660 ASSIGN 8871 TO MVI H4100670 DO 4103 KCAVI =1,2 H4100680 DO 4103 KCBVI = 1,2,1 H4100690 DO 4103 KCCVI = 4,5,1 H4100700 DO 4103 KCDVI = 2,3 H4100710 GO TO 8878 H4100720 8877 GO TO 4103 H4100730 8878 KCEVI = KCAVI + KCBVI + KCCVI + KCDVI + KCEVI H4100740 GO TO 8877 H4100750 4103 CONTINUE H4100760 IF(KCEVI - 160)8866,8871,8866 H4100770 C***** TEST OF DO WITH I/O STATEMENTS H4100780 8871 ASSIGN 8860 TO MVI H4100790 KCHVI = 4108 H4100800 REWIND IXVI H4100810 DO 8863 KCAVI = 1,4 H4100820 KCA1I(KCAVI) = KCAVI H4100830 WRITE(IXVI)(KCA1I(KCBVI),KCBVI = 1,KCAVI,1) H4100840 8863 CONTINUE H4100850 DO 8864 KCCVI =1,4 H4100860 8864 REWIND IXVI H4100870 DO 4108 KCDVI = 1,4 H4100880 READ(IXVI)(KAC1I(KCEVI),KCEVI = 1,KCDVI ) H4100890 DO 4108 KCFVI = 1, KCDVI H4100900 KCGVI = KAC1I(KCFVI)-KCA1I(KCFVI) H4100910 IF(KCGVI) 8866,4108,8866 H4100920 4108 CONTINUE H4100930 8860 WRITE(NXVI,8868) H4100940 GO TO 8869 H4100950 8866 WRITE(NXVI,8867) KCHVI H4100960 GO TO MVI,(8860,4102,8870,8871,8876) H4100970 8869 REWIND IXVI H4100980 RETURN H4100990 C***** END OF TEST SEGMENT 410 H4101000 END H4101010 C***********************************************************************H4120010 C***** H4120020 C***** MDQ - (412) H4120030 C***** H4120040 C***********************************************************************H4120050 C***** GENERAL PURPOSE ASA REF H4120060 C***** THIS SUBROUTINE IS USED WITH SEGMENT 197 TO H4120070 C***** SHOW THAT SUBROUTINES MAY BE CALLED FROM DO LOOPS H4120080 SUBROUTINE MDQ(MWVI,IWVI) H4120090 IWVI = MWVI + IWVI H4120100 RETURN H4120110 C***** END OF TEST SEGMENT 412 H4120120 END H4120130 C***********************************************************************H4190010 C***** H4190020 C***** BLAKD - (419) H4190030 C***** H4190040 C***********************************************************************H4190050 C***** GENERAL PURPOSE H4190060 C***** THIS SEGMENT CONTAINS THE FIRST OF THREE BLOCK DATA SUBPROGRAMSH4190070 C***** TO BE RUN WITH SEGMENT 179 H4190080 C***** THESE SEGMENTS USE ALL THE PERMISSIBLE STATEMENTS IN A H4190090 C***** BLOCK DATA SUBPROGRAM. THE DATA STATEMENTS CONSIST OF ALL H4190100 C***** TYPES OF VARIABLES AND ARRAYS. A HOLLERITH CONSTANT IS H4190110 C***** ASSIGNED TO INTEGER , REAL, AND LOGICAL H4190120 BLOCK DATA H4190130 DOUBLE PRECISION DXVD, DX1D, DX2D H4190140 COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H4190150 A /BLK2/ DXVS, DX1S(2), DX2S(2,2) H4190160 B /BLK3/ DXVD, DX1D(2), DX2D(2,2) H4190170 INTEGER JXVI H4190180 REAL DXVS H4190190 DATA JXVI, JAX1I(1), JAX2I(1,2), DXVS, DX1S(2) H4190200 A ,DX2S(1,2), DXVD, DX1D(1), DX2D(1,2)/ 3 * 1 H4190210 B ,3 * 2.0,3*4.0D0/, JAX2I(1,3),DX2S(2,1)/2HHP,2HHP/ H4190220 C***** END OF TEST SEGMENT 419 H4190230 END H4190240 C***********************************************************************H4290010 C***** H4290020 C***** BLBKD - (429) H4290030 C***** H4290040 C***********************************************************************H4290050 C***** TO BE RUN WITH SEGMENT 179 H4290060 C***** THIS SEGMENT CONTAINS THE 2ND OF THREE BLOCK DATA SUBPROGRAMS H4290070 C***** TO BE RUN WITH SEGMENT 179 H4290080 BLOCK DATA H4290090 COMPLEX DXVC, DX1C, DX2C H4290100 COMMON /BLK4/ DXVC,DX1C(2), DX2C(2,2) H4290110 C /BLK5/DXVB, DX1B(2), DX2B(2,2) H4290120 LOGICAL DXVB, DX1B, DX2B H4290130 DATA DXVC, DX1C(1), DX2C(1,2),DXVB, DX1B(1),DX2B(1,2)/ H4290140 D 3 * (3.,4.), 3 *.FALSE./ H4290150 C***** END OF TEST SEGMENT 429 H4290160 END H4290170 C***********************************************************************H4390010 C***** H4390020 C***** BLCKD - (439) H4390030 C***** H4390040 C***********************************************************************H4390050 C***** THIS SEGMENT CONTAINS THE THIRD OF THREE BLOCK DATA SUBPROGRAMSH4390060 C***** TO BE RUN WITH SEGMENT 179 H4390070 BLOCK DATA H4390080 COMMON /BLK6/JAX3I(2,2,2),DX3S(2,2,2),DX3D(2,2,2) H4390090 E ,DZ3C(2,2,2), DX3B(2,2,2) H4390100 DOUBLE PRECISION DX3D H4390110 DIMENSION CY3C(2,2,2) H4390120 COMPLEX DZ3C,CY3C H4390130 EQUIVALENCE (DZ3C(1,1,1), CY3C(1,1,1)) H4390140 LOGICAL DX3B H4390150 DATA JAX3I(1,1,2),DX3S(1,1,2),DX3D(1,1,2),CY3C(1,1,2),DX3B(1,1,2)/H4390160 F 1, 2.0, 4.0D0, (3.,4.),.FALSE./ ,DX3B(2,2,2)/ H4390170 G 2HHP/ H4390180 C***** END OF TEST SEGMENT 439 H4390190 END H4390200