C***** PART13 ****************************************************H0006000 C***** H0006005 C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS H0006010 C***** H0006015 C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3 H0006020 C***** H0006025 C***** JUNE 1974 H0006030 C***** H0006035 C***** PART 13 OF 14 PARTS H0006040 C***** H0006045 C***** SEGMENTS INCLUDED H0006050 C***** H0006055 C***** LOGIF - 300 LOGICAL IF STATEMENTS H0006060 C***** H0006065 C***** SMCQ - 411 SUBROUTINE H0006070 C***** H0006075 C***** BARIF - 301 ARITHMETIC IF STATEMENTS H0006080 C***** H0006085 C***** FARIF - 302 ARITHMETIC IF STATEMENTS H0006090 C***** H0006095 C***** IOFMT - 310 FORMATTED READ, WRITE H0006100 C***** H0006105 C***** RDFMT - 312 FORMATS IN ARRAYS H0006110 C***** H0006115 C***** FMTQ - 462 SUBROUTINE H0006120 C***** H0006125 C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS H0016000 C***** 300, 301, 302, 310, 312 ARE RUN AS ONE MAIN PROGRAM. H0016005 C***** H0016010 REAL MVS H0016015 DIMENSION L1I(10) H0016020 DIMENSION IAC2I(2,7),ZU1S(13),ZU3S(3,2,2),ZU2S(4,2),ZT1S(4) H0016025 DIMENSION A1S(5 ),A2S(2,2),A3S(3,3,3),YER1S(7),EP1S(33) H0016030 DIMENSION IAC1I(5),MCA1I(5),AC1S(25),AC2S(5,6),CMA1S(5) H0016035 INTEGER AVI,IU2I(4,2),IT3I(4,2,2),IU3I(2,3,3), MCA3I(2,3,3) H0016040 LOGICAL MCAVB, MCBVB, MCA1B(7), AVB, BVB, CVB, GG1B(2), A1B(2) H0016045 COMPLEX CHAVC,CHBVC H0016050 DOUBLE PRECISION MCAVD, MCBVD, MCCVD, A1D(4), A2D(2,2), A3D(2,2,2)H0016055 1 ,DPAVD, DPBVD,DPCVD,DPEVD,DPFVD,DPHVD,DPDVD,AAAVD H0016060 C***** H0016065 C***** END OF SPECIFICATIONS FOR SEGMENTS 300, 301, 302, 310, 312 H0016070 C***********************************************************************H3000010 C***** H3000020 C***** LOGIF - (300) H3000030 C***** H3000040 C***********************************************************************H3000050 C***** GENERAL PURPOSE ASA REF H3000060 C***** TEST LOGICAL IF STATEMENT 7.1.2.3H3000070 C***** GENERAL COMMENT H3000080 C***** ASSIGNED GO TO,INTRINSIC FUNCTION,ARITHMETIC IF,CALL, H3000090 C***** COMPUTED GO TO AND I/O STATEMENTS ASSUMED WORKING. H3000100 C***** H3000110 C***** S P E C I F I C A T I O N S SEGMENT 300 H3000120 C***** H0016075 C***** WHEN EXECUTING ONLY SEGMENT 300, REMOVE THE PRECEDING H0016080 C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS, WHICH APPEAR H0016085 C***** AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0016090 C***** H0016095 C= LOGICAL MCAVB,MCBVB,MCA1B(7) H0016100 C= DOUBLE PRECISION DPAVD, DPBVD,DPCVD,DPDVD,DPEVD,DPFVD H0016105 C***** H0016110 C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS. H3000130 IRVI = 5 H0076000 NUVI = 6 H0076005 C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS H0076010 WRITE(NUVI,0071) H0076015 0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S// H0076020 1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS// H0076025 3 37H FOR USE ON LARGE FORTRAN PROCESSORS // H0076030 4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966// H0076035 5 23H VERSION 3 PART 13///) H0076040 C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER H0076045 C PREPARED BY USER H0076050 C READ, NO LIST H0076055 C PREPARED BY USER H0076060 C READ, NO LIST H0076065 C PREPARED BY USER H0076070 C READ, NO LIST H0076075 C READ(IRVI,0070) H0076080 C READ(IRVI,0072) H0076085 C READ(IRVI,0073) H0076090 0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /) H0076095 0072 FORMAT(40H TEST PROGRAMS /) H0076100 0073 FORMAT(40H FORTRAN COMPILER /) H0076105 WRITE(NUVI,0070) H0076110 WRITE(NUVI,0072) H0076115 WRITE(NUVI,0073) H0076120 WRITE (NUVI,3000) H3000140 3000 FORMAT (1H1, 1X,34HLOGIF - (300) LOGICAL IF STATEMENT// H3000150 120H ASA REF. - 7.1.2.3//10H RESULTS // H3000160 2/37H TEST EXPLICITLY WRITTEN SIGNED ZERO/2X) H3000170 C***** HEADER FOR SEGMENT 300 WRITTEN H3000180 MACVI = 0 H3000190 MCAVB = .TRUE. H3000200 MCBVB = .FALSE. H3000210 MCA1B(1) = .TRUE. H3000220 MCA1B(2) = .FALSE. H3000230 C***** TEST THAT MINUS ZERO AND PLUS ZERO ARE TREATED 4.2/11H3000240 C***** AS EQUAL VALUES H3000250 IVI = -8 H3000260 IIVI = -8 H3000270 JVI = +0 H3000280 JJVI = -0 H3000290 KVI = 8 H3000300 KKVI = 8 H3000310 AVS = -0.5 H3000320 AAVS = -0.5 H3000330 BVS = +0.0 H3000340 BBVS = -0.0 H3000350 CVS = 0.5 H3000360 CCVS = 0.5 H3000370 DPAVD = -0.5D0 H3000380 DPBVD = -0.5D0 H3000390 DPCVD = +0.0D0 H3000400 DPDVD = -0.0D0 H3000410 DPEVD = 0.5D0 H3000420 DPFVD = 0.5D0 H3000430 C***** TEST FOR EXPLICITLY WRITTEN -0 EQUAL TO +0 H3000440 IF((JVI) .EQ. (JJVI))MACVI = MACVI + 1 H3000450 IF((JJVI) .EQ. (JVI)) MACVI = MACVI + 1 H3000460 IF((+0) .EQ. (-0)) MACVI = MACVI + 1 H3000470 IF((-0) .EQ. (+0)) MACVI = MACVI + 1 H3000480 IF (MACVI - 4) 9951, 9954, 9951 H3000490 9951 WRITE (NUVI, 9953) H3000500 GO TO 9955 H3000510 9952 FORMAT(14H +0 EQUALS -0) H3000520 9953 FORMAT(17H +0 NOT EQUAL -0) H3000530 9954 WRITE (NUVI, 9952) H3000540 9955 MACVI = 0 H3000550 C***** TEST EXPLICITLY WRITTEN +0.0 EQUALS -0.0 H3000560 IF ((BVS) .EQ. (BBVS)) MACVI = MACVI + 1 H3000570 IF ((BBVS) .EQ. (BVS)) MACVI = MACVI + 1 H3000580 IF ((+0.0) .EQ. (-0.0)) MACVI = MACVI + 1 H3000590 IF ((-0.0) .EQ. ( 0.0)) MACVI = MACVI + 1 H3000600 IF (MACVI - 4) 9944, 9947, 9944 H3000610 9944 WRITE (NUVI, 9946) H3000620 GO TO 9948 H3000630 9945 FORMAT (18H +0.0 EQUALS -0.0) H3000640 9946 FORMAT (21H +0.0 NOT EQUAL -0.0) H3000650 9947 WRITE (NUVI, 9945) H3000660 C***** TEST EXPLICITLY WRITTEN +0.0D0 EQUALS -0.0D0 H3000670 9948 MACVI = 0 H3000680 IF ((DPCVD) .EQ. (DPDVD)) MACVI = MACVI +1 H3000690 IF ((DPDVD).EQ. (DPCVD)) MACVI = MACVI + 1 H3000700 C***** H3000710 IF ((+0.0D0) .EQ. (-0.0D0)) MACVI = MACVI + 1 H3000720 IF ((-0.0D0) .EQ. (0.0D0)) MACVI = MACVI + 1 H3000730 IF (MACVI - 4) 9949, 9957, 9949 H3000740 9949 WRITE (NUVI, 9960) H3000750 GO TO 9958 H3000760 9959 FORMAT (22H +0.0D0 EQUALS -0.0D0) H3000770 9960 FORMAT (25H +0.0D0 NOT EQUAL -0.0D0) H3000780 9957 WRITE (NUVI, 9959) H3000790 9958 MACVI = 0 H3000800 WRITE (NUVI, 7950) H3000810 7950 FORMAT (33H0 TEST COMPUTATIONAL SIGN OF ZERO/2X) H3000820 C***** TEST FOR COMPUTATIONALLY CREATED +0 AND -0 H3000830 IF((IVI * JVI) .EQ. (JVI))MACVI = MACVI + 1 H3000840 IF((JVI) .EQ. (JVI * IIVI))MACVI = MACVI + 1 H3000850 IF((JVI / IVI) .EQ. (+0) )MACVI = MACVI + 1 H3000860 IF((IVI + KVI) .EQ. (JVI))MACVI = MACVI + 1 H3000870 IF((KKVI + IIVI) .EQ. (JVI))MACVI = MACVI + 1 H3000880 IF((IIVI - IVI) .EQ. (JVI))MACVI = MACVI + 1 H3000890 IF((KVI - KKVI) .EQ. (JVI))MACVI = MACVI + 1 H3000900 IF (MACVI - 7) 9956, 9940, 9956 H3000910 9956 WRITE (NUVI,9953) H3000920 GO TO 7955 H3000930 9940 WRITE (NUVI,9952) H3000940 C***** TEST FOR COMPUTATIONALLY CREATED +0.0 AND -0.0 H3000950 7955 MACVI = 0 H3000960 IF ((AVS * BVS) .EQ. (BVS)) MACVI = MACVI + 1 H3000970 IF ((BVS) .EQ. (BVS * AAVS)) MACVI = MACVI + 1 H3000980 IF ((BVS / AVS) .EQ. ( 0.0)) MACVI = MACVI + 1 H3000990 IF ((AVS + CVS) .EQ. (BVS)) MACVI = MACVI + 1 H3001000 IF ((CCVS + AAVS) .EQ. (BVS)) MACVI = MACVI + 1 H3001010 IF ((AAVS - AVS) .EQ. (BVS)) MACVI = MACVI + 1 H3001020 IF ((CVS - CCVS) .EQ. (BVS)) MACVI = MACVI + 1 H3001030 IF (MACVI - 7) 7951, 7952, 7951 H3001040 7951 WRITE (NUVI, 9946) H3001050 GO TO 7953 H3001060 7952 WRITE (NUVI, 9945) H3001070 C***** TEST FOR COMPUTATIONALLY CREATED +0.0D0 AND -0.0D0 H3001080 7953 MACVI = 0 H3001090 IF ((DPAVD * DPCVD) .EQ. (DPCVD)) MACVI = MACVI + 1 H3001100 IF ((DPCVD) .EQ. (DPCVD * DPBVD)) MACVI = MACVI + 1 H3001110 IF ((DPCVD / DPAVD) .EQ. (0.0D0)) MACVI = MACVI + 1 H3001120 IF ((DPAVD + DPEVD) .EQ. (DPCVD)) MACVI = MACVI + 1 H3001130 IF ((DPFVD + DPBVD) .EQ. (DPCVD)) MACVI = MACVI + 1 H3001140 IF ((DPBVD - DPAVD) .EQ. (DPCVD)) MACVI = MACVI + 1 H3001150 IF ((DPEVD - DPFVD) .EQ. (DPCVD)) MACVI = MACVI + 1 H3001160 IF (MACVI - 7) 7954, 9939, 7954 H3001170 7954 WRITE (NUVI, 9960) H3001180 GO TO 9941 H3001190 9939 WRITE (NUVI, 9959) H3001200 9941 MCAVI = 0 H3001210 WRITE (NUVI, 9942) H3001220 9942 FORMAT(31H0 TEST -LOGICAL IF- FOLLOWED BY/ H3001230 131H DIFFERENT KINDS OF STATEMENTS ) H3001240 C***** TEST 1 H3001250 C***** LOGICAL IF FOLLOWED BY SIMPLE ASSIGNMENT STATEMENT H3001260 C***** CORRECT RESULT = 0, OTHERWISE RESULT = 1 H3001270 IF (MCA1B(2)) MCAVI = 1 H3001280 WRITE (NUVI,3009) MCAVI H3001290 C***** TEST 2 H3001300 C***** LOGICAL IF FOLLOWED BY USE OF INTRINSIC FUNCTION H3001310 C***** CORRECT RESULT =0, OTHERWISE RESULT =2 H3001320 MCAVI = 2 H3001330 IF (MCAVB) MCAVI = IFIX(5.0 - 4.0 - 1.0) H3001340 WRITE (NUVI,3009) MCAVI H3001350 MCAVI = 0 H3001360 C***** TEST 3 H3001370 C***** LOGICAL IF FOLLOWED BY ARITHMETIC STATEMENT H3001380 C***** CORRECT RESULT =0, OTHERWISE RESULT =3 H3001390 IF (MCAVB .AND. MCBVB) MCAVI = 3* 2 / 2 H3001400 WRITE (NUVI,3009) MCAVI H3001410 C***** TEST 4 H3001420 C***** LOGICAL IF FOLLOWED BY GO TO STATEMENT H3001430 C***** CORRECT RESULT =0, OTHERWISE RESULT =4 H3001440 MCAVI = 0 H3001450 IF (MCAVB .AND. MCBVB .OR. MCA1B(1)) GO TO 3001 H3001460 MCAVI = 4 H3001470 3001 WRITE (NUVI,3009) MCAVI H3001480 C***** TEST 5 H3001490 C***** LOGICAL IF FOLLOWED BY CALL STATEMENT H3001500 C***** CORRECT RESULT =0, OTHERWISE RESULT =5 H3001510 MCAVI =0 H3001520 IF (MCBVB .OR. (1 .GE. 2) .AND..FALSE.) CALL SMCQ(MCAVI) H3001530 WRITE (NUVI,3009) MCAVI H3001540 C***** TEST 6 H3001550 C***** LOGICAL IF FOLLOWED BY NESTED USE OF INTRINSIC FUNCTIONS H3001560 C***** CORRECT RESULT =0, OTHERWISE RESULT =6 H3001570 MCAVI = 6 H3001580 IF (.TRUE. .OR. ((1. .LE. (0.1 + 1.5)) .AND. (MCA1B(1) .OR. .TRUE H3001590 1.)) .AND. MCBVB) MCAVI = IFIX(REAL((0.0,1.0))) H3001600 WRITE (NUVI,3009) MCAVI H3001610 C***** TEST 7 H3001620 C***** LOGICAL IF FOLLOWED BY ASSIGNED GO TO STATEMENT H3001630 C***** CORRECT RESULT =0, OTHERWISE RESULT =7 H3001640 ASSIGN 3002 TO MCBVI H3001650 MCAVI = 7 H3001660 IF (.NOT. (MCAVB .AND. MCBVB .AND. .FALSE. .OR. (.NOT. .TRUE.))) H3001670 1GO TO MCBVI,(3001,3002,3003) H3001680 GO TO 3003 H3001690 3002 MCAVI = 0 H3001700 3003 WRITE (NUVI,3009) MCAVI H3001710 C***** TEST 8 H3001720 C***** LOGICAL IF FOLLOWED BY ARITHMETIC IF STATEMENT H3001730 C***** CORRECT RESULT =0, OTHERWISE RESULT =8 H3001740 MCAVI = 0 H3001750 IF (.NOT. (.NOT.(.TRUE. .OR. MCAVB .AND. (8. .NE. 7.)))) H3001760 1IF (MCAVI) 3004,3005,3004 H3001770 3004 MCAVI = 8 H3001780 3005 WRITE (NUVI,3009) MCAVI H3001790 C***** TEST 9 H3001800 C***** LOGICAL IF FOLLOWED BY I/O STATEMENT H3001810 C***** CORRECT RESULT =0, OTHERWISE RESULT =9 H3001820 MCAVI = 0 H3001830 IF ((8.0D0 .EQ. (1. + 7.)) .AND. (.NOT. (3 .NE. 3))) H3001840 1WRITE (NUVI,3009) MCAVI H3001850 C***** TEST 10 H3001860 C***** LOGICAL IF FOLLOWED BY COMPUTED GO TO STATEMENT H3001870 C***** CORRECT RESULT =0, OTHERWISE RESULT =10 H3001880 MCAVI = 2 H3001890 IF ( .TRUE. .AND. (8 .GE. 6) .OR. (.FALSE.)) GO TO (9950,3006), H3001900 1MCAVI H3001910 9950 MCAVI = 10 H3001920 GO TO 3007 H3001930 3006 MCAVI = 0 H3001940 3007 WRITE (NUVI,3009) MCAVI H3001950 WRITE (NUVI,3008) H3001960 C***** TEST EXPRESSIONS IN LOGICAL IF STATEMENTS H3001970 C***** TEST 11 .LT. EXPRESSION, RELATION, EXPRESSION (TRUE) H3001980 MCAVI = 11 H3001990 IF((SNGL(DABS(-DSIGN(DBLE(2.0),1.0D0)))).LT.AMIN1((FLOAT(IDIM H3002000 1 (1 + 2, 0))), (AIMAG(CMPLX(1.0,2.0)))) + 1.0) MCAVI = 0 H3002010 WRITE (NUVI, 3009) MCAVI H3002020 C***** TEST 12 .LT. EXPRESSION, RELATION, CONSTANT (TRUE) H3002030 MACVI = 12 H3002040 IF((AMIN1(FLOAT(IDIM(4 - 1,0)) , AIMAG(CMPLX(1.0,2.0)))).LT. 4.0) H3002050 1MACVI = 0 H3002060 WRITE (NUVI, 3009) MACVI H3002070 C***** TEST 13 .LT. CONSTANT(D.P.),RELATION, EXPRESSION (REAL)(TRUE)H3002080 MACVI = 13 H3002090 C*****IF (1.(D0).LT. (SNGL(DABS(DSIGN(DBLE(4.0),1.0D0))))) MACVI = 0 H3002100 C*****WRITE (NUVI, 3009) MACVI H3002110 C***** TEST 14 .LE. .AND. .LE. (SHOULD BE LESS AND EQUAL) (TRUE) H3002120 MACVI = 14 H3002130 IF((REAL(CONJG((1.0,-2.0))) + AIMAG((16.0,-4.0)) .LE. H3002140 1 AIMAG(CONJG((1.0,-2.0))) + REAL((-4.0,16.0)) + 1.0) .AND. H3002150 2 (AIMAG(CONJG((2.0,-4.0))) + REAL((-8.0,16.0)).LE. H3002160 3 REAL(CONJG((4.0,-2.0))) + AIMAG((16.0,-8.0))))MACVI = 0 H3002170 WRITE (NUVI, 3009) MACVI H3002180 C***** TEST I5 .LE. (FALSE) H3002190 MACVI = 0 H3002200 IF (MAX1((AMAX0(4,2,-(1 * 4))),16.0) .LE. 2 ** 3)MACVI = 15 H3002210 WRITE (NUVI, 3009) MACVI H3002220 C***** TEST 16 .NE. .AND. .EQ. (TRUE) H3002230 MACVI = 16 H3002240 IF(((AINT(AINT(AINT(1.4 + 2.9)+1.6)-8.1)).NE.(-8.0)).AND.(-1.0.EQ.H3002250 1AINT(AINT(AINT(2.6 + 4.8) + 1.4)-9.2)))MACVI = 0 H3002260 WRITE (NUVI, 3009) MACVI H3002270 C***** TEST 17 .GT. (TRUE) H3002280 MACVI = 17 H3002290 IF((FLOAT(IABS(IFIX(ABS(-5.0+ SIGN(-1.0,2.0)))))) .GT. 2.0D0) H3002300 1MACVI = 0 H3002310 WRITE (NUVI, 3009) MACVI H3002320 C***** TEST 18 .GE. EQUAL (TRUE) H3002330 MACVI = 18 H3002340 IF((8.0).GE.(FLOAT(IABS(IFIX(ABS(-4.0+SIGN(4.0,-2.0)))))))MACVI=0 H3002350 WRITE (NUVI, 3009) MACVI H3002360 C***** TEST 19 .GE. GREATER (TRUE) H3002370 MACVI = 19 H3002380 IF((MACVI).GE.(IABS(IFIX(ABS(-4.0 + SIGN(8.0,-4.0))))))MACVI = 0 H3002390 WRITE (NUVI, 3009) MACVI H3002400 C***** TEST 20 .GT. (FALSE) .OR. .EQ. (TRUE) H3002410 MACVI = 20 H3002420 IF((-MACVI) .GT. (MAX1 (AMAX0(8,-(2*4),4) ,16.0)).OR. .NOT.(IABS H3002430 1 (-20) .NE. MACVI))MACVI = 0 H3002440 WRITE (NUVI, 3009) MACVI H3002450 WRITE (NUVI, 9943) H3002460 9943 FORMAT(28H0 ALL VALUES SHOULD BE ZERO./ H3002470 137H A VALUE OTHER THAN ZERO WILL BE THE / H3002480 234H NUMBER OF THE TEST WHICH FAILED. ) H3002490 3008 FORMAT(34H0 THERE SHOULD BE 10 VALUES ABOVE, / H3002500 131H IF ONLY 9, TEST 9 HAS FAILED.) H3002510 3009 FORMAT(12X, I10) H3002520 C***** END OF TEST SEGMENT 300 H3002530 C***** WHEN EXECUTING ONLY SEGMENT 300, THE STOP AND END CARDS H3002540 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H3002550 C***** IN COLUMNS 1 AND 2 REMOVED. H3002560 C= STOP H3002570 C= END H3002580 C***********************************************************************H3010010 C***** H3010020 C***** BARIF - (301) H3010030 C***** H3010040 C***********************************************************************H3010050 C***** GENERAL PURPOSE ASA REF H3010060 C***** TEST BASIC FORTRAN ARITHMETIC IF STATEMENT 7.1.2.2H3010070 C***** GENERAL COMMENTS H3010080 C***** BASIC INTRINSIC FUNCTIONS ASSUMED WORKING H3010090 C***** H3010100 C***** S P E C I F I C A T I O N S SEGMENT 301 H3010110 C***** H0016115 C***** WHEN EXECUTING ONLY SEGMENT 301, THE SPECIFICATION STATEMENTS H0016120 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0016125 C***** IN COLUMNS 1 AND 2 REMOVED. H0016130 C= DIMENSION L1I(10) H0016135 C= DIMENSION MCA1I(5),CMA1S(5) H0016140 C***** H0016145 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H3010120 C***** H0076125 C***** WHEN EXECUTING ONLY SEGMENT 301, THE FOLLOWING STATEMENT H0076130 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0076135 C***** H0076140 C= NUVI = 6 H0076145 C***** H0076150 WRITE (NUVI,3010) H3010130 3010 FORMAT (1H1,1X,27HBARIF - (301) BASIC FORTRAN/15X, 24HH3010140 1 ARITHMETIC IF STATEMENT/2X,18HASA REF. - 7.1.2.2/2X,7HRESULTS) H3010150 C***** HEADER FOR SEGMENT 301 WRITTEN H3010160 MCA1I(1) = 5 H3010170 MCAVI = 0 H3010180 MCBVI = 21 H3010190 JACVI = -0 H3010200 CMA1S(1) = 10.5 H3010210 CMAVS = -0.0 H3010220 CMBVS = -15.E0 H3010230 C***** TEST FOR SIGN OF ZERO - TYPE INTEGER 4.2/11 H3010240 DO 8335 IVI = 1,9 H3010250 8335 L1I(IVI) = 0 H3010260 MVI = 1 H3010270 KVI = 0 H3010280 JVI = -0 H3010290 BVS = -0.0 H3010300 NVI = 1 H3010310 WRITE (NUVI, 8300) H3010320 IF (-0) 8311, 8314, 8317 H3010330 8320 IF (0) 8312, 8315, 8318 H3010340 8321 IF (+0) 8313, 8316, 8319 H3010350 8322 NVI = 10 H3010360 IF (JVI + (-0)) 8311, 8314, 8317 H3010370 8323 IF (-IABS(JVI)) 8312, 8315, 8318 H3010380 8324 IF (-JVI + (+0)) 8313, 8316, 8319 H3010390 8325 WRITE (NUVI, 8303)(L1I(IVI), IVI = 1,9) H3010400 C***** TEST FOR SIGN OF ZERO - TYPE REAL H3010410 MVI = 2 H3010420 KVI = 0 H3010430 NVI = 1 H3010440 DO 8336 IVI = 1,9 H3010450 8336 L1I(IVI) = 0 H3010460 WRITE (NUVI, 8304) H3010470 IF (-0.0) 8311, 8314, 8317 H3010480 8326 IF (0.0) 8312, 8315, 8318 H3010490 8327 IF (+0.0) 8313, 8316, 8319 H3010500 8328 NVI = 10 H3010510 IF (BVS +(-0.0)) 8311, 8314, 8317 H3010520 8329 IF (-ABS(BVS)) 8312, 8315, 8318 H3010530 8330 IF (-BVS + (+0.0)) 8313, 8316, 8319 H3010540 8331 WRITE (NUVI, 8303) (L1I(IVI), IVI = 1,9) H3010550 WRITE (NUVI, 8337) H3010560 GO TO 8305 H3010570 C***** SWITCH FOR INTEGER AND REAL TESTS H3010580 8332 KVI = KVI + 1 H3010590 GO TO (8333, 8334) , MVI H3010600 C***** RETURNS FOR TEST SIGN OF INTEGER ZERO H3010610 8333 GO TO (8320, 8321, 8322, 8323, 8324, 8325), KVI H3010620 C***** RETURNS FOR TEST SIGN OF REAL ZERO H3010630 8334 GO TO (8326, 8327, 8328, 8329, 8330, 8331), KVI H3010640 C***** TALLY RESULTS OF CONTROL TRANSFERS H3010650 8311 L1I(1) = L1I(1) + NVI H3010660 GO TO 8332 H3010670 8312 L1I(2) = L1I(2) + NVI H3010680 GO TO 8332 H3010690 8313 L1I(3) = L1I(3) + NVI H3010700 GO TO 8332 H3010710 8314 L1I(4) = L1I(4) + NVI H3010720 GO TO 8332 H3010730 8315 L1I(5) = L1I(5) + NVI H3010740 GO TO 8332 H3010750 8316 L1I(6) = L1I(6) + NVI H3010760 GO TO 8332 H3010770 8317 L1I(7) = L1I(7) + NVI H3010780 GO TO 8332 H3010790 8318 L1I(8) = L1I(8) + NVI H3010800 GO TO 8332 H3010810 8319 L1I(9) = L1I(9) + NVI H3010820 GO TO 8332 H3010830 8300 FORMAT(/ 38H TEST FOR SIGN OF ZERO - TYPE INTEGER// 29H PATH * FH3010840 1ORM OF EXPRESSION */ 29H OF IF * -0 * 0 * +0 * ) H3010850 8303 FORMAT( 1H ,7(4H****)/ 1H ,4(6X,1H*)/ 8H NEG. *,3(I4,3H *)/1H ,4H3010860 1(6X,1H*)/8H ZERO *,3(I4,3H *)/1H ,4(6X,1H*)/8H POS. *,3(I4, H3010870 23H *)/1H , 4(6X,1H*)/1H ) H3010880 8304 FORMAT(//35H TEST FOR SIGN OF ZERO - TYPE REAL // 29H PATH * FOH3010890 1RM OF EXPRESSION */ 29H OF IF * -0.0 * 0.0 * +0.0 * ) H3010900 8337 FORMAT(/34H ALL ENTRIES SHOULD BE 0 EXCEPT /36H THE ZERO PATH,H3010910 1 WHICH SHOULD BE 11 /33H IN EACH COLUMN. OTHER TESTS MAY / 31HH3010920 2 FAIL IF THESE RESULTS DIFFER.///37H TEST EXPRESSIONS IN IF STH3010930 3ATEMENTS /1H ) H3010940 C***** ARITHMETIC IF WITH EXPRESSIONS OF TYPE INTEGER H3010950 C***** TEST 1 - SHOULD TAKE ZERO BRANCH H3010960 8305 IF (MCA1I(1) - 5) 9981,3011,9981 H3010970 C***** TEST 2 - SHOULD TAKE ZERO BRANCH H3010980 3011 IF (MCA1I(1) + 5 - IFIX(CMA1S(1))) 9982,3012,9982 H3010990 C***** TEST 3 - SHOULD TAKE MINUS BRANCH H3011000 3012 IF ((MCBVI * 2 / 7) - IABS(IFIX(10.5 - 10.4)) - 7) 3013,9983,9983 H3011010 C***** TEST 4 - SHOULD TAKE PLUS BRANCH H3011020 3013 IF ((MCA1I(1) - 4) ** 99 /(MCBVI - 4 * MCA1I(1))) 9984,9984,3014 H3011030 C***** ARITHMETIC IF WITH EXPRESSION OF TYPE REAL H3011040 C***** TEST 5 - SHOULD TAKE ZERO BRANCH H3011050 3014 IF (CMA1S(1) - 10.5) 9985,3015,9985 H3011060 C***** TEST 6 - SHOULD TAKE MINUS BRANCH H3011070 3015 IF (CMA1S(1) * 2.0 -(FLOAT(MCBVI) **1) - 1.0) 3016,9986,9986 H3011080 C***** TEST 7 - SHOULD TAKE PLUS BRANCH H3011090 3016 IF (CMBVS * (-2.0) ** (MCBVI - 4 * MCA1I(1)) - 29.0)9987,9987,3017H3011100 C***** TEST 8 - SHOULD TAKE ZERO BRANCH H3011110 3017 IF (MCAVI) 9988,3018,9980 H3011120 3018 WRITE (NUVI,3019) H3011130 GO TO 9980 H3011140 3019 FORMAT ( 18H TESTS SUCCESSFUL ) H3011150 9981 MCAVI = 1 H3011160 IF (IABS(MCA1I(1) - 5)) 8301,8302,8301 H3011170 8301 WRITE (NUVI,9989) MCAVI H3011180 GO TO 3011 H3011190 8302 WRITE (NUVI,8306) MCAVI H3011200 8306 FORMAT (//2X,14HERROR IN TEST ,I2,23H BECAUSE MINUS ZERO WAS/ H3011210 1 30H TREATED AS A NEGATIVE NUMBER) H3011220 GO TO 3011 H3011230 9982 MCAVI = 2 H3011240 IF (IABS(MCA1I(1) + 5 - IFIX(CMA1S(1)))) 8307,8308,8307 H3011250 8307 WRITE (NUVI,9989) MCAVI H3011260 GO TO 3012 H3011270 8308 WRITE (NUVI,8306) MCAVI H3011280 GO TO 3012 H3011290 9983 MCAVI = 3 H3011300 WRITE (NUVI,9989) MCAVI H3011310 GO TO 3013 H3011320 9984 MCAVI = 4 H3011330 WRITE (NUVI,9989) MCAVI H3011340 GO TO 3014 H3011350 9985 MCAVI = 5 H3011360 IF (ABS(CMA1S(1) - 10.5)) 8309,8310,8309 H3011370 8309 WRITE (NUVI,9989) MCAVI H3011380 GO TO 3015 H3011390 8310 WRITE (NUVI,8306) MCAVI H3011400 GO TO 3015 H3011410 9986 MCAVI = 6 H3011420 WRITE (NUVI,9989) MCAVI H3011430 GO TO 3016 H3011440 9987 MCAVI = 7 H3011450 WRITE (NUVI,9989) MCAVI H3011460 GO TO 3017 H3011470 9988 MCAVI = 8 H3011480 WRITE (NUVI,9989) MCAVI H3011490 9989 FORMAT ( 6H TEST,I2,7H FAILED) H3011500 9980 CONTINUE H3011510 C***** END OF TEST SEGMENT 301 H3011520 C***** WHEN EXECUTING ONLY SEGMENT 301, THE STOP AND END CARDS H3011530 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H3011540 C***** IN COLUMNS 1 AND 2 REMOVED. H3011550 C= STOP H3011560 C= END H3011570 C***********************************************************************H3020010 C***** H3020020 C***** FARIF - (302) H3020030 C***** H3020040 C***********************************************************************H3020050 C***** GENERAL PURPOSE ASA REF H3020060 C***** TEST OF FULL FORTRAN ARITHMETIC IF STATEMENT 7.1.2.2H3020070 C***** GENERAL COMMENTS H3020080 C***** INTRINSIC FUNCTIONS ASSUMED WORKING H3020090 C***** H3020100 C***** S P E C I F I C A T I O N S SEGMENT 302 H3020110 C***** H0016150 C***** WHEN EXECUTING ONLY SEGMENT 302, THE SPECIFICATION STATEMENTS H0016155 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0016160 C***** IN COLUMNS 1 AND 2 REMOVED. H0016165 C***** H0016170 C= DIMENSION MCA1I(5),AC2S(5,6) H0016175 C= DOUBLE PRECISION MCAVD,MCBVD H0016180 C= COMPLEX CHAVC H0016185 C***** H0016190 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H3020120 C***** H0076155 C***** WHEN EXECUTING ONLY SEGMENT 302, THE FOLLOWING STATEMENT H0076160 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0076165 C***** H0076170 C= NUVI = 6 H0076175 C***** H0076180 WRITE (NUVI,3020) H3020130 3020 FORMAT (1H1,1X,26HFARIF - (302) FULL FORTRAN/ 16X,24HARITHMETIC IH3020140 1F STATEMENTS/ H3020150 220H ASA REF. - 7.1.2.2/2X,7HRESULTS) H3020160 C***** HEADER FOR SEGMENT 302 WRITTEN H3020170 MCA1I(1) = 5 H3020180 MCAVI = 0 H3020190 AC2S(1,1) = 10.5 H3020200 MCAVD = -15.0D0 H3020210 CHAVC = (1.0,2.0) H3020220 MCBVD = -0.0D0 H3020230 C***** ARITHMETIC IF WITH EXPRESSION OF TYPE DOUBLE PRECISION H3020240 C***** TEST THAT MINUS ZERO IS TREATED AS ZERO 4.2/11H3020250 IF (MCBVD) 9301,9303,9301 H3020260 9301 WRITE (NUVI,9302) H3020270 9302 FORMAT (//2X,37HERROR, MINUS ZERO TREATED AS NEGATIVE/ H3020280 1 36H NUMBER - OTHER TESTS MAY FAIL AS A/ H3020290 2 8H RESULT) H3020300 MCAVI = 0 H3020310 C***** TEST 1 - SHOULD TAKE ZERO BRANCH H3020320 9303 IF (MCAVD + 15.0D0) 3028,3021,3028 H3020330 C***** TEST 2 - SHOULD TAKE MINUS BRANCH H3020340 3021 IF (MCAVD / DBLE(FLOAT(MCA1I(1))) * 2.D0) 3022,3029,3029 H3020350 C***** TEST 3 - SHOULD TAKE MINUS BRANCH H3020360 3022 IF (MCAVD/(-15.0D0) + 6.0D0 - 2.0D0 ** 3) 3023,9971,9971 H3020370 C***** TEST 4 - SHOULD TAKE PLUS BRANCH H3020380 3023 IF (DSIGN(1.0D0,DBLE(REAL(CHAVC)))) 9972,9972,3024 H3020390 C***** TEST 5 - SHOULD TAKE ZERO BRANCH H3020400 3024 IF (2.0D0 ** 2 - 4.0D0/ 1.0D0) 9973, 3025, 9973 H3020410 3025 IF (MCAVI) 9974,3026,9970 H3020420 3026 WRITE (NUVI,3027) H3020430 GO TO 9970 H3020440 3027 FORMAT (//34H SEGMENT 302 TESTED SUCCESSFULLY.) H3020450 3028 MCAVI = 1 H3020460 IF (DABS(MCAVD + 15.0D0))9304,9305,9304 H3020470 9304 WRITE (NUVI,9975) MCAVI H3020480 GO TO 3021 H3020490 9305 WRITE (NUVI,9306) MCAVI H3020500 9306 FORMAT (//2X,14HERROR IN TEST ,I2,23H BECAUSE MINUS ZERO WAS/ H3020510 1 30H TREATED AS A NEGATIVE NUMBER) H3020520 GO TO 3021 H3020530 3029 MCAVI = 2 H3020540 WRITE (NUVI,9975) MCAVI H3020550 GO TO 3022 H3020560 9971 MCAVI = 3 H3020570 WRITE (NUVI,9975) MCAVI H3020580 GO TO 3023 H3020590 9972 MCAVI = 4 H3020600 WRITE (NUVI,9975) MCAVI H3020610 GO TO 3024 H3020620 9973 MCAVI = 5 H3020630 IF (DABS(2.0D0 ** 2 - 4.0D0 / 1.0D0)) 9307, 9308, 9307 H3020640 9307 WRITE (NUVI,9975) MCAVI H3020650 GO TO 3025 H3020660 9308 WRITE (NUVI,9306) MCAVI H3020670 GO TO 3025 H3020680 9974 MCAVI = 6 H3020690 WRITE (NUVI,9975) MCAVI H3020700 9975 FORMAT (//6H TEST,I3,8H FAILED.) H3020710 9970 CONTINUE H3020720 C***** END OF TEST SEGMENT 302 H3020730 C***** WHEN EXECUTING ONLY SEGMENT 302, THE STOP AND END CARDS H3020740 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H3020750 C***** IN COLUMNS 1 AND 2 REMOVED. H3020760 C= STOP H3020770 C= END H3020780 C***********************************************************************H3100010 C***** H3100020 C***** IOFMT - (310) H3100030 C***** H3100040 C***********************************************************************H3100050 C***** GENERAL PURPOSE ASA REFSH3100060 C***** TO TEST ADDITIONAL FEATURES OF FORMATTED READ 7.1.3.2.2H3100070 C***** AND WRITE STATEMENTS AND FORMAT STATEMENTS 7.1.3.2.3H3100080 C***** RESTRICTIONS OBSERVED H3100090 C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57H3100100 C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54H3100110 C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 7.2.3.1/31H3100120 C***** W IS EQUAL TO OR GREATER THAN D 7.2.3.1/33H3100130 C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18H3100140 C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22H3100150 C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER H3100160 C***** THAN H OR X) H3100170 C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36H3100180 C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 7.2.3.6/56H3100190 C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01H3100200 C***** * FOR I CONVERSION, EXTERNAL INPUT FIELDS ARE 7.2.3.6.1/07H3100210 C***** INTEGER CONSTANTS H3100220 C INPUT DATA TO THIS SEGMENT CONSISTS OF 38 CARD IMAGES IN COL. 1 - 80 H3100230 C COLS. 22 25 31 34-35 40-43 55 67 69 74-76 H3100240 CARD 1 . . . 0. E+00 + + . E00 H3100250 C COLS. 16 31 33 42-45 50 59-60 H3100260 CARD 2 + + . D+00 . D0 H3100270 C COLS. 1-----------14 18-----26 28-------38 42-------------58 H3100280 CARD 3 1.23456987654. +1.234E-0 -98.7654E+0 + 2345.67891011+2 H3100290 C COLS. 69-----78 H3100300 CARD 3 -.109876-4 H3100310 C COLS 1---5 H3100320 CARDS 4,5,6,7,8 12345 H3100330 C COLS. 1-3 H3100340 CARDS 9,10,11,12 1.1 H3100350 C COLS. 1------------------------------------------------------58 H3100360 CARD 13 +0.339567E+02 H3100370 CARD 14 + .339567+2 H3100380 CARD 15 + 3.395670E1 H3100390 CARD 16 0.96295134244D+04 H3100400 CARD 17 .96295134244D04 H3100410 CARD 18 0.96295134244+4 H3100420 CARD 19 0.96295134244D+04 H3100430 CARD 20 31.23+0.14E+04+0.2D+02 H3100440 CARD 21 31.23 .14E+04 +.2+2 H3100450 CARD 22 -0.13579E+054444 H3100460 CARD 23 4444 H3100470 CARD 24 4444 H3100480 CARD 25 4444 H3100490 CARD 26 4444 H3100500 CARD 27 -333 5.555+0.4545E-04 H3100510 CARD 28 -6.666 .9989E+12 H3100520 CARD 29 7.77-0.747E-02 +0.549E022 H3100530 CARD 30 +0.662E-00 0.468-1011 H3100540 CARD 31 0.59542D+04-44.6666-0.1234567890D-03 H3100550 CARD 32 54.9327-0.1395624534D+00 H3100560 CARD 33 65432.1 H3100570 CARD 34 +0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21 H3100580 CARD 35 22222222222222222222222222222222222222222222222222 H3100590 CARD 36 -.987E0-0.987E+00 +0.6D0 + 0.6D+00 .368D-5 H3100600 CARD 37 5 5 5 5 H3100610 CARD 38 987654 8647.86 987.654 H3100620 CARD COLS. NOT MENTIONED ARE BLANK H3100630 C***** H3100640 C***** READ AND WRITE STATEMENTS FOR ENTIRE SEGMENT FOLLOW H3100650 C***** H3100660 C***** TEST THAT COMPLETELY BLANK FIELDS IN THE INPUT 7.2.3.6/45H3100670 C***** ARE TREATED AS ZEROS. (ALL VARIABLES AND ARRAY H3100680 C***** ELEMENTS USED IN THIS TEST ARE FIRST SET TO H3100690 C***** NON-ZERO VALUES. I, E, F AND D DESCRIPTORS H3100700 C***** APPEAR IN THE CORRESPONDING FORMAT STATEMENT H3100710 C***** H3100720 C***** S P E C I F I C A T I O N S SEGMENT 310 H3100730 C***** H0016195 C***** WHEN EXECUTING ONLY SEGMENT 310, THE SPECIFICATION STATEMENTS H0016200 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0016205 C***** IN COLUMNS 1 AND 2 REMOVED. H0016210 C***** H0016215 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3),EP1S(33) H0016220 C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6) H0016225 C= INTEGER MCA3I(2,3,3) H0016230 C= REAL MVS H0016235 C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,A1D(4),A2D(2,2),A3D(2,2,2) H0016240 C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPHVD,AAAVD H0016245 C***** H0016250 C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS H3100740 C***** H0076185 C***** WHEN EXECUTING ONLY SEGMENT 310, THE FOLLOWING STATEMENTS H0076190 C***** NUVI = 6 , IRVI = 5 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.H0076195 C= NUVI = 6 H0076200 C= IRVI = 5 H0076205 C***** H0076210 C***** HEADER FORMAT STATEMENT H3100750 3100 FORMAT (1H1,1X,38HIOFMT - (310) ADDITIONAL FORMATTED I/O H3100760 1 //2X,38HASA REFS - 7.1.3.2.2 7.1.3.2.3 7.2.3//2X,7HRESULTS) H3100770 WRITE (NUVI,3100) H3100780 JACVI = 11111 H3100790 IAC1I(1) = -2345 H3100800 IAC2I(1,1) = 9999 H3100810 MCA3I(1,1,1) = 2 H3100820 ACVS = 1.2 H3100830 BCVS = -.34E-3 H3100840 A1S(1) = 34.56 H3100850 A1S(2) = 456.789E+02 H3100860 A2S(1,1) = -7899.3 H3100870 A2S(2,1) = +9876.543E-01 H3100880 A3S(1,1,1) = .543 H3100890 A3S(2,1,1) = 4.33E+1 H3100900 AAAVD = +2.22D+01 H3100910 A1D(1) = -.33456D-01 H3100920 A2D(1,1) = 9987.76D+2 H3100930 A3D(1,1,1) = 44.D-2 H3100940 C***** FORMATS TO TEST THAT BLANK INPUT FIELDS ARE 7.2.3.6/45H3100950 C***** TREATED AS ZEROS. I, E, F AND D FIELDS ARE TESTED H3100960 C***** CARDS 1 AND 2 H3100970 3101 FORMAT (4(I5), 4(F3.1), 4(E11.4)/ 4(D15.8)) H3100980 READ (IRVI,3101) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS, H3100990 1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1), H3101000 2 A3S(2,1,1), AAAVD, A1D(1), A2D(1,1), A3D(1,1,1) H3101010 3102 FORMAT ( /2X,16HTEST BLANK INPUT/2X,26HEACH ANSWER SHOULD BE ZERO,H3101020 1 4(/I6) / 4(/F8.1) / 4(/E12.1) / 4(/D12.1)) H3101030 WRITE (NUVI,3102) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS,H3101040 1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1), H3101050 2 A3S(2,1,1), AAAVD, A1D(1), A2D(1,1), A3D(1,1,1) H3101060 C***** TEST THAT DECIMAL POINTS APPEARING IN INPUT FIELDS 7.2.3.6/47H3101070 C***** OVERRIDE THE SPECIFICATIONS SUPPLIED BY E, F AND H3101080 C***** D FIELD DESCRIPTORS H3101090 3103 FORMAT (/34H TEST DEC. PT. SPECIFIED BY INPUT/ 36H 3 LINES IN EAH3101100 1CH GROUP SHOULD MATCH / 26H * LINE IS HOLLERITH DATA ) H3101110 WRITE (NUVI,3103) H3101120 CMAVS = 1.23456 H3101130 CMBVS = 987654. H3101140 CMEVS = 0.1234E+01 H3101150 CMFVS = -0.987654E+02 H3101160 DPAVD = 0.234567891011D+06 H3101170 DPBVD = -0.109876D-04 H3101180 C***** CARD 3 H3101190 3104 FORMAT (2(F7.3), 2(E12.5), 2(D20.11)) H3101200 READ (IRVI,3104) ACVS, BCVS, FFCVS, GGCVS, MCAVD, MCBVD H3101210 3105 FORMAT (/12H * 1.23456,2(/F12.5)//13H * 987654.0,2(/F13.1) / H3101220 1 /15H * 0.1234E+01,2(/E15.4)//17H * -0.987654E+02,2(/E17.6) / H3101230 2 /23H * 0.234567891011D+06, 2(/D23.12)//17H * -0.109876D-04, H3101240 3 2(/D17.6) ) H3101250 WRITE (NUVI,3105) CMAVS, ACVS, CMBVS, BCVS, CMEVS, FFCVS, CMFVS, H3101260 1 GGCVS, DPAVD, MCAVD, DPBVD, MCBVD H3101270 C***** TEST SIMPLE REPETITION OF FORMAT DESCRIPTORS 7.2.3.4/ H3101280 C***** WHEN ADDITIONAL ITEMS REMAIN IN AN I/O LIST 7.1.3.2.1/ H3101290 C***** AND THE LAST RIGHT PARENTHESIS HAS BEEN REACHED H3101300 C***** IN THE CORRESPONDING FORMAT STATEMENT H3101310 3106 FORMAT ( 35H1 TEST FORMAT DESCRIPTOR REPETITION/ 32H ALL LINES H3101320 1IN EACH GROUP SHOULD/ 14H BE IDENTICAL) H3101330 WRITE (NUVI,3106) H3101340 JACVI = +12345 H3101350 KBCVI = 3 H3101360 CMAVS = 1.1 H3101370 CMBVS = 1.23 H3101380 CMEVS = 33.9567 H3101390 CMGVS = 1.4E+03 H3101400 DPAVD = 962951342.44D-5 H3101410 DPBVD = 2.0D1 H3101420 C***** CARDS 4, 5, 6, 7, 8 H3101430 3107 FORMAT (I5) H3101440 READ (IRVI,3107) IAC1I H3101450 C***** CARDS 9, 10, 11, 12 H3101460 3108 FORMAT (F3.1) H3101470 READ (IRVI,3108) A2S H3101480 C***** CARDS 13, 14, 15 H3101490 9320 FORMAT (E13.6) H3101500 READ (IRVI,9320) A1S(1), HHCVS, A1S(2) H3101510 C***** CARDS 16, 17, 18, 19 H3101520 9321 FORMAT (D18.11) H3101530 READ (IRVI,9321) A2D H3101540 C***** CARDS 20, 21 H3101550 9322 FORMAT (I1,F4.2,E9.2,D8.1) H3101560 READ (IRVI,9322) LCCVI, DCVS, AC2S(5,6), A3D(1,2,2), MDCVI, FFCVS,H3101570 1 GGCVS, AAAVD H3101580 9323 FORMAT ( /10H * 12345) H3101590 WRITE (NUVI,9323) H3101600 9324 FORMAT (I10) H3101610 WRITE (NUVI,9324) JACVI, IAC1I H3101620 9325 FORMAT (/ 8H * 1.1) H3101630 WRITE (NUVI,9325) H3101640 9326 FORMAT (F8.1) H3101650 WRITE (NUVI,9326) CMAVS, A2S H3101660 9329 FORMAT (/17H * 0.339567E+02) H3101670 WRITE (NUVI,9329) H3101680 9330 FORMAT (E17.6) H3101690 WRITE (NUVI,9330) CMEVS, A1S(1), HHCVS, A1S(2) H3101700 9331 FORMAT (/22H * 0.96295134244D+04) H3101710 WRITE (NUVI,9331) H3101720 9332 FORMAT (D22.11) H3101730 WRITE (NUVI,9332) DPAVD, A2D H3101740 9333 FORMAT (/31H * 3 1.23 0.14E+04 0.2D+02) H3101750 WRITE (NUVI,9333) H3101760 9334 FORMAT (I6,F6.2,E10.2,D9.1) H3101770 WRITE (NUVI,9334) KBCVI, CMBVS, CMGVS, DPBVD, LCCVI, DCVS, H3101780 1 AC2S(5,6), A3D(1,2,2), MDCVI, FFCVS, GGCVS, AAAVD H3101790 C***** TEST THAT FORMAT CONTROL PASSES TO THE GROUP 7.2.3.4/03H3101800 C***** ENCLOSED BY THE LAST PRECEDING RIGHT PAREN. 7.1.3.2.1/39H3101810 C***** WHEN THE I/O LIST CONTAINS MORE ELEMENTS THAN H3101820 C***** THE NUMBER OF DESCRIPTORS IN THE FORMAT STMNT. H3101830 JACVI = +4444 H3101840 KBCVI = -333 H3101850 LCCVI = 22 H3101860 MDCVI = 11 H3101870 ACVS = 5.555 H3101880 BCVS = -6.666 H3101890 CCVS = +7.77 H3101900 DCVS = 65432.1 H3101910 CMAVS = -0.13579E+5 H3101920 CMBVS = 0.4545E-04 H3101930 CMCVS = 0.9989E12 H3101940 CMDVS = -0.747E-2 H3101950 CMEVS = +0.549E+00 H3101960 CMFVS = 0.662E-0 H3101970 CMGVS = 0.468E-10 H3101980 DPAVD = +59.542D02 H3101990 DPBVD = -0.0123456789D-2 H3102000 DPCVD = -1395624534.D-10 H3102010 DPDVD = +129.D4 H3102020 DPEVD = 4.12D+20 H3102030 DPFVD = 36.8D-7 H3102040 DPHVD = 0.6D00 H3102050 FFCVS = -44.6666 H3102060 GGCVS = +.549327E+2 H3102070 HHCVS = 848. H3102080 MVS = -.987 H3102090 CMHVS = 1.23E-1 H3102100 CMIVS = 646.E-2 H3102110 C***** CARDS 22, 23, 24, 25, 26 H3102120 9335 FORMAT ( E12.5, (I4)) H3102130 READ (IRVI,9335) A1S(2), IAC1I H3102140 C***** CARDS 27, 28 H3102150 9336 FORMAT (I4, (F6.3), E11.4) H3102160 READ (IRVI,9336) MRRVI, AC1S(1), EP1S(1), A3S(1,1,1), AC2S(2,2) H3102170 C***** CARDS 29, 30 H3102180 9337 FORMAT (F4.2, (2(E10.3)), I2) H3102190 READ (IRVI,9337) A2S(2,2), A3S(2,1,1), EP1S(2), MCA3I(1,1,1), H3102200 1 BVS, AC2S(2,1), NECVI H3102210 C***** CARDS 31, 32 H3102220 9338 FORMAT (D12.5, (F8.4, D17.10)) H3102230 READ (IRVI,9338) MCAVD, EP1S(3), A1D(1), A2S(1,2), A2D(2,1) H3102240 C***** CARDS 33, 34, 35, 36 H3102250 C***** THIS READ CAUSES AN INPUT DATA CARD TO BE SKIPPED H3102260 9339 FORMAT( F7.1, (/2(E10.3), 2(D10.3)), D10.3) H3102270 READ (IRVI,9339) CVS, A2S(2,1), A3S(1,2,2), A3D(1,1,1), H3102280 1 A3D(1,2,1), A2D(2,2), A3S(1,2,1), EP1S(4), H3102290 2 A1D(2), MCBVD, MCCVD H3102300 9340 FORMAT (/16H * -0.13579E+05,2(/E16.5)//9H * 4444,6(/I9)) H3102310 WRITE (NUVI,9340) CMAVS, A1S(2), JACVI, IAC1I H3102320 9341 FORMAT (/ 8H * -333, 2(/I8)/ 10H1 * 5.555, 2(/F10.3) // H3102330 115H * 0.4545E-04, 2(/E15.4)// 10H * -6.666, 2(/F10.3) // H3102340 215H * 0.9989E+12, 2(/E15.4)) H3102350 WRITE (NUVI,9341) KBCVI, MRRVI, ACVS, AC1S(1), CMBVS, EP1S(1), H3102360 1 BCVS, A3S(1,1,1), CMCVS, AC2S(2,2) H3102370 9342 FORMAT (/9H * 7.77 ,2(/F9.2)//14H * -0.747E-02, 2(/E14.3) // H3102380 1 14H * 0.549E+00, 2(/E14.3) //7H * 22, 2(/I7) // H3102390 2 14H * 0.662E+00, 2(/E14.3) //14H * 0.468E-10, 2(/E14.3) // H3102400 3 7H * 11, 2(/I7) ) H3102410 WRITE (NUVI,9342) CCVS, A2S(2,2), CMDVS, A3S(2,1,1), CMEVS, H3102420 1 EP1S(2), LCCVI, MCA3I(1,1,1), CMFVS, BVS, CMGVS, AC2S(2,1), H3102430 2 MDCVI, NECVI H3102440 9343 FORMAT (/16H * 0.59542D+04,2(/D16.5)//12H * -44.6666,2(/F12.4)/H3102450 1/21H * -0.1234567890D-03,2(/D21.10)/12H1 * 54.9327,2(/F12.4)// H3102460 2 21H * -0.1395624534D+00,2(/D21.10) ) H3102470 WRITE (NUVI,9343) DPAVD, MCAVD, FFCVS, EP1S(3), DPBVD, A1D(1), H3102480 1 GGCVS, A2S(1,2), DPCVD, A2D(2,1) H3102490 9344 FORMAT (/12H * 65432.1/ 2(F12.1/) / 14H * 0.848E+03/ H3102500 1 3(E14.3/) / 14H * 0.129D+07/ 3(D14.3/) / 14H * 0.412D+21/ H3102510 2 2(D14.3/) / 14H * -0.987E+00/ 3(E14.3/) / 12H * 0.6D+00/ H3102520 3 3(D12.1/) / 14H * 0.368D-05, 2(/D14.3) ) H3102530 WRITE (NUVI,9344) DCVS, CVS, HHCVS, A2S(2,1), A3S(1,2,2), DPDVD, H3102540 1 A3D(1,1,1), A3D(1,2,1), DPEVD, A2D(2,2), H3102550 2 MVS, A3S(1,2,1), EP1S(4), DPHVD, A1D(2), MCBVD, H3102560 3 DPFVD, MCCVD H3102570 9345 FORMAT (/14H * 0.777E+01/ (E14.3)) H3102580 WRITE (NUVI,9345) CCVS, A2S(2,2) H3102590 9346 FORMAT (/ 22H * -333 0.59542D+04/I8, D14.5 ) H3102600 WRITE (NUVI,9346) KBCVI, DPAVD, MRRVI, MCAVD H3102610 9347 IF (MRRVI - 5) 9348, 9349, 9348 H3102620 C***** CARD 37 H3102630 9348 READ (IRVI, 9336) MRRVI H3102640 GO TO 9347 H3102650 C***** * ADDITIONAL SCALE FACTOR ON INPUT-OUTPUT H3102660 C***** CARD 38 H3102670 9349 READ(IRVI, 9327) A1S(3), A1S(4), A1D(4) H3102680 9327 FORMAT ( 1PE10.3, -1PE10.2, D10.3) H3102690 WRITE(NUVI, 9328) A1S(3), A1S(4), A1D(4) H3102700 9328 FORMAT(//22H1 SCALE FACTOR ON READ/ 31H IN ORDER OF FORMAT OCCURRH3102710 2ENCE/28H NO EXPONENT ON INPUT DATA // H3102720 3 40H CARD 987654 8647.86 987.654/ H3102730 4 40H DESC 1PE10.3 -1PE10.2 D10.3/ H3102740 5 40H TO BE .988E+02 .8648E+05 .9877D+04/ H3102750 6 4H IS, E12.3, E12.4, D12.4) H3102760 C***** END OF TEST SEGMENT 310 H3102770 C***** WHEN EXECUTING ONLY SEGMENT 310, THE STOP AND END CARDS H3102780 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H3102790 C***** IN COLUMNS 1 AND 2 REMOVED. H3102800 C= STOP H3102810 C= END H3102820 C***********************************************************************H3120010 C***** H3120020 C***** RDFMT - (312) H3120030 C***** H3120040 C***********************************************************************H3120050 C***** GENERAL PURPOSE ASA REFSH3120060 C***** TO TEST FORMATTED READ AND WRITE STATEMENTS 7.2.3.10H3120070 C***** IN WHICH THE FORMAT STATEMENT IS CONTAINED IN H3120080 C***** AN ARRAY H3120090 C***** RESTRICTIONS OBSERVED H3120100 C***** * AN H DESCRIPTOR MAY NOT BE PART OF A FORMAT 7.2.3.10/48H3120110 C***** STATEMENT IN AN ARRAY H3120120 C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57H3120130 C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54H3120140 C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 7.2.3.1/31H3120150 C***** W IS EQUAL TO OR GREATER THAN D 7.2.3.1/33H3120160 C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18H3120170 C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22H3120180 C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER H3120190 C***** THAN H OR X) H3120200 C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36H3120210 C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 7.2.3.6/56H3120220 C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01H3120230 C***** * FOR I CONVERSION, EXTERNAL INPUT FIELDS ARE 7.2.3.6.1/07H3120240 C***** INTEGER CONSTANTS H3120250 C***** TEST HOLLERITH IN ARGUMENT OF A CALL H3120260 C***** ARRAY NAME IN ARGUMENT LIST USED AS FORMAT SPECIFIER H3120270 C***** SUBROUTINE FMTQ ALSO TESTS THE EMPTY FORMAT STATEMENT H3120280 C***** THE FOLLOWING DATA STATEMENTS INITIALIZE SOME 7.2.3.10/50H3120290 C***** ARRAYS WITH FORMAT STATEMENTS TO BE USED FOR H3120300 C***** READING WITH A, F AND D CONVERSION AND FOR H3120310 C***** WRITING WITH I, E AND L CONVERSION H3120320 C***** H3120330 C INPUT DATA TO THIS SEG. CONSISTS OF 13 CARD IMAGES IN COLS. 1 - 80 H3120340 C COLS. 1-----------------------------------------------50 H3120350 CARD 1 (I5,6X, I4, 2(I3), I2) H3120360 CARD 2 (E 9.2,3(E13.6)) H3120370 CARD 3 ( L1 ,2(L2),L3) H3120380 CARD 4 (2X,A2,5(A2)) H3120390 CARD 5 (2X,F5.3, F4.0, 2(F7.2)) H3120400 CARD 6 (2X , D 16.9,D9.2) H3120410 CARD 7 4756 -867224+39-6 H3100420 CARD 8 23498.-77.27547.18 H3120430 CARD 9 -.0076+11+08.93421E-13 893.421E-15+08.93421E-13 H3120440 CARD 10 -0.357901246D+00 +0.52D-2 H3120450 CARD 11 TTA FF9$ H3120460 CARD 12 AB H3120470 CARD 13 CDE+*=123 H3120480 CARD COLS. NOT MENTIONED ARE BLANK H3120490 C***** H3120500 C***** S P E C I F I C A T I O N S SEGMENT 312 H3120510 C***** H0016255 C***** WHEN EXECUTING ONLY SEGMENT 312, THE SPECIFICATION STATEMENTS H0016260 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H0016265 C***** IN COLUMNS 1 AND 2 REMOVED. H0016270 C***** H0016275 C= DIMENSION L1I(10),A3S(3,3,3),YER1S(7),IAC1I(5),AC1S(25) H0016280 C= DIMENSION ZU3S(3,2,2),ZT1S(4),ZU1S(12),ZU2S(4,2),IAC2I(2,7) H0016285 C= INTEGER AVI,IU2I(4,2),IT3I(4,2,2),IU3I(2,3,3),MCA3I(2,3,3) H0016290 C= LOGICAL AVB,BVB,CVB,GG1B(2),A1B(2) H0016295 C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,A1D(4) H0016300 C= COMPLEX CHAVC,CHBVC H0016305 C***** H0016310 C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS H3120520 C***** H0076215 C***** WHEN EXECUTING ONLY SEGMENT 312, THE FOLLOWING STATEMENTS H0076220 C***** NUVI=6 AND IRVI=5 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0076225 C***** H0076230 C= NUVI = 6 H0076235 C= IRVI = 5 H0076240 C***** H0076245 DATA IU2I(1,1),IU2I(2,1),IU2I(3,1),IU2I(4,1),IU2I(1,2),IU2I(2,2), H3120530 1 IU2I(3,2)/2H(A,2H2/,2H2X,2H,5,2H(A,2H2),1H) / H3120540 DATA ZU1S(1),ZU1S(2),ZU1S(3),ZU1S(4),ZU1S(5),ZU1S(6),ZU1S(7), H3120550 1 ZU1S(8),ZU1S(9),ZU1S(10),ZU1S(11),ZU1S(12) / H3120560 2 2H( ,2H ,2HF3,2H.3,1H,,2HF3,2H.0,2H, ,2H2(,2HF6,2H.2,2H)) / H3120570 DATA IU3I(1,1,1),IU3I(2,1,1),IU3I(1,2,1),IU3I(2,2,1),IU3I(1,3,1), H3120580 1 IU3I(2,3,1),IU3I(1,1,2),IU3I(2,1,2) / H3120590 2 2H( ,2H D,2H16,2H.9,2H, ,1HD,2H9.,2H2) / H3120600 DATA IT3I(1,1,1),IT3I(2,1,1),IT3I(3,1,1),IT3I(4,1,1),IT3I(1,2,1), H3120610 1 IT3I(2,2,1),IT3I(3,2,1),IT3I(4,2,1),IT3I(1,1,2),IT3I(2,1,2), H3120620 2 IT3I(3,1,2),IT3I(4,1,2),IT3I(1,2,2) /2H(2,2HX,,2HI5,2H,1, H3120630 3 2HX,,2HI4,2H,I,2H4,,2H1X,2H,I,2H2,,2HI3,1H) / H3120640 DATA ZT1S(1),ZT1S(2),ZT1S(3),ZT1S(4)/2H(E,2H11,2H.2,1H) / H3120650 DATA ZU3S(1,1,1),ZU3S(2,1,1),ZU3S(3,1,1),ZU3S(1,2,1),ZU3S(2,2,1), H3120660 1 ZU3S(3,2,1) / 2H(4,2H(E,2H14,2H.6,2H/),1H) / H3120670 DATA ZU2S(1,1),ZU2S(2,1),ZU2S(3,1),ZU2S(4,1),ZU2S(1,2),ZU2S(2,2), H3120680 2 ZU2S(3,2) / 2H(L,2H3,,2H2(,2HL2,2H),,2HL3,1H) / H3120690 C***** THE FOLLOWING READ STATEMENTS INITIALIZE SOME 7.2.3.10/51H3120700 C***** ARRAYS WITH FORMAT STATEMENTS TO BE USED FOR H3120710 C***** READING WITH I, E AND L CONVERSIONS AND FOR H3120720 C***** WRITING WITH A, F AND D CONVERSIONS H3120730 C***** H3120740 WRITE (NUVI,3120) H3120750 C***** CARD 1 H3120760 READ (IRVI,3121) AC1S(1), AC1S(2), AC1S(3), AC1S(4), AC1S(5), H3120770 1 AC1S(6),AC1S(7),AC1S(8),AC1S(9),AC1S(10),AC1S(11),AC1S(12) H3120780 C***** CARD 2 H3120790 READ (IRVI,3122) L1I H3120800 C***** CARD 3 H3120810 READ (IRVI,3121) A3S H3120820 C***** CARD 4 H3120830 READ (IRVI,3123) YER1S H3120840 C***** CARD 5 H3120850 READ (IRVI,3124) MCA3I H3120860 C***** CARD 6 H3120870 READ (IRVI,3124) IAC2I H3120880 C***** H3120890 C***** H3120900 C***** THE FOLLOWING STATEMENTS MAKE USE OF THE FORMATS H3120910 C***** CONTAINED IN THE ARRAYS H3120920 C***** H3120930 C***** READ AND WRITE WITH I CONVERSION USING FORMATS IN ARRAYS H3120940 JACVI = 4756 H3120950 KBCVI = -867 H3120960 LCCVI = 224 H3120970 MDCVI = +39 H3120980 NECVI = -6 H3120990 C***** CARD 7 WITH CARD 1 AS FORMAT H3121000 READ (IRVI,AC1S) AVI, MRRVI, IAC1I(1), IAC1I(2), IAC1I(3) H3121010 WRITE (NUVI,3125) H3121020 WRITE(NUVI,IT3I)JACVI, KBCVI, LCCVI, MDCVI, NECVI, AVI, MRRVI, H3121030 1 IAC1I(1), IAC1I(2), IAC1I(3) H3121040 C***** READ AND WRITE WITH F CONVERSION USING FORMATS IN ARRAYS H3121050 AVS = .234 H3121060 BVS = 98. H3121070 CHAVC = (-77.27,+547.18E0) H3121080 C***** CARD 8 FORMAT IS (F3.3,F3.0,2(F6.2)) H3121090 READ (IRVI,ZU1S) CVS, DVS, CHBVC H3121100 WRITE (NUVI,3127) H3121110 WRITE (NUVI,MCA3I) AVS, BVS, CHAVC H3121120 WRITE (NUVI,MCA3I) CVS, DVS, CHBVC H3121130 C***** READ AND WRITE WITH E CONVERSION USING FORMATS IN ARRAYS H3121140 AVS = -0.76E+9 H3121150 BVS = +08.93421E-13 H3121160 C***** CARD 9 WITH CARD 2 AS FORMAT H3121170 READ (IRVI,L1I) ZU3S(2,2,2),CVS,DVS,ZU3S(1,2,2) H3121180 WRITE (NUVI,3128) H3121190 WRITE(NUVI,ZT1S) AVS, ZU3S(2,2,2) H3121200 WRITE (NUVI,3129) H3121210 WRITE (NUVI, ZU3S) BVS,ZU3S(1,2,2),CVS, DVS H3121220 C***** READ AND WRITE WITH D CONVERSION USING FORMATS IN ARRAYS H3121230 DPAVD = -0.357901246D+00 H3121240 DPBVD = +.00052D+1 H3121250 C***** CARD 10 FORMAT IS (D16.9,D9.2) H3121260 READ (IRVI,IU3I) A1D(1), DPCVD H3121270 WRITE (NUVI,9930) H3121280 WRITE (NUVI,IAC2I) DPAVD,DPBVD,A1D(1),DPCVD H3121290 C***** READ AND WRITE WITH L CONVERSION USING FORMATS IN ARRAYS H3121300 AVB = .TRUE. H3121310 BVB = .FALSE. H3121320 C***** CARD 11 WITH CARD 3 AS FORMAT H3121330 READ (IRVI,A3S) A1B(1), A1B(2), CVB, GG1B(2) H3121340 WRITE (NUVI,9931) H3121350 WRITE (NUVI, ZU2S) AVB, AVB, BVB, BVB H3121360 WRITE (NUVI,ZU2S) A1B(1), A1B(2), CVB, GG1B(2) H3121370 C***** READ AND WRITE WITH A CONVERSION USING FORMATS IN ARRAYS H3121380 C***** CARDS 12 AND 13 FORMAT IS (A2/2X,5(A2)) H3121390 READ (IRVI,IU2I) JACVI, AVS, IAC1I(1), GG1B, BVB H3121400 WRITE (NUVI,3126) H3121410 WRITE (NUVI,YER1S) JACVI, AVS, IAC1I(1), GG1B, BVB H3121420 C***** H3121430 CALL FMTQ (NUVI,ZT1S,0.9999,2HH0,2HLL,2HER,2HIT,2HH ,2HCO,2HNS, H3121440 1 2HTA,2HNT,2HS ,2HAS,2H C,2HAL,2HL ,2HAR,2HGU,2HME,2HNT,1HS) H3121450 C***** H3121460 C***** ADDITIONAL FORMAT STATEMENTS REQUIRED BY THIS SEGMENT H3121470 C***** H3121480 C***** THE FOLLOWING FORMAT STATEMENTS ARE USED TO 7.2.3.10/51H3121490 C***** READ FORMATS INTO ARRAYS H3121500 3121 FORMAT (27(A2)) H3121510 3122 FORMAT (10(A2)) H3121520 3123 FORMAT ( 7(A2)) H3121530 3124 FORMAT (18(A2)) H3121540 C***** THE FOLLOWING ARRAYS ARE USED TO WRITE OUT ALL 7.2.3.10/48H3121550 C***** HOLLERITH INFORMATION, SINCE H FIELD DESCRIPTORS H3121560 C***** MAY NOT BE PART OF A FORMAT WITHIN AN ARRAY H3121570 3120 FORMAT (1H1,1X,31HRDFMT - (312) FORMATS IN ARRAYS// H3121580 1 22H ASA REFS. - 7.2.3.10//34H EACH GROUP OF LINES SHOULD MATCH)H3121590 3125 FORMAT (/ 22H 4756 -867 224 39 -6) H3121600 3126 FORMAT (/ 13H ABCDE+*=123) H3121610 3127 FORMAT (/ 25H 0.234 98. -77.27 547.18) H3121620 3128 FORMAT (/11H -0.76E+09) H3121630 3129 FORMAT (/14H 0.893421E-12) H3121640 9930 FORMAT (/ 27H -0.357901246D+00 0.52D-02) H3121650 9931 FORMAT (/ 10H T T F F) H3121660 C***** END OF TEST SEGMENT 312 H3121670 C***** WHEN EXECUTING ONLY SEGMENT 312, THE STOP AND END CARDS H3121680 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H3121690 C***** IN COLUMNS 1 AND 2 REMOVED. H3121700 C= STOP H3121710 C= END H3121720 STOP H9999995 END H9999999 C***********************************************************************H4110010 C***** H4110020 C***** SMCQ - (411) H4110030 C***** H4110040 C***********************************************************************H4110050 C***** GENERAL PURPOSE H4110060 C***** TO DEFINE SUBROUTINE SMCQ WHICH IS USED IN SEGMENT 300 H4110070 SUBROUTINE SMCQ(MWVI) H4110080 MWVI = MWVI + 5 H4110090 RETURN H4110100 C***** END OF TEST SEGMENT 411 H4110110 END H4110120 C***********************************************************************H4620010 C***** H4620020 C***** FMTQ - (462) H4620030 C***** H4620040 C***********************************************************************H4620050 C***** GENERAL PURPOSE H4620060 C***** TO DEFINE SUBROUTINE FMTQ WHICH IS USED IN SEGMENT 312 H4620070 C***** TO TEST FORMAT IN AN ARRAY PASSED AS AN ARGUMENT, AN H4620080 C***** EMPTY FORMAT STATEMENT, AND H4620090 C***** HOLLERITH IN A CALL ARGUMENT H4620100 SUBROUTINE FMTQ(NWVI,ZTW1S,AWVS,IWVH,JWVH,KWVH,LWVH,MWVH,NWVH, H4620110 1 IIWVH,JJWVH,KKWVH,LLWVH,MMWVH,NNWVH,IJWVH,IKWVH, H4620120 2 ILWVH,IMWVH,INWVH,JIWVH,JKWVH) H4620130 DIMENSION ZTW1S(4) H4620140 WRITE (NWVI, 4620) H4620150 4620 FORMAT(/11H +.10E+01 ) H4620160 C*****FORMAT LABELED ZTW1S PASSED AS ARGUMENT IS (E11.2) H4620170 WRITE (NWVI, ZTW1S) AWVS H4620180 WRITE (NWVI, 4621) H4620190 4621 FORMAT(/39H HOLLERITH CONSTANTS AS CALL ARGUMENTS ) H4620200 WRITE (NWVI,4622) IWVH, JWVH,KWVH,LWVH,MWVH,NWVH,IIWVH,JJWVH, H4620210 1 KKWVH, LLWVH,MMWVH,NNWVH,IJWVH,IKWVH,ILWVH, H4620220 2 IMWVH,INWVH,JIWVH,JKWVH H4620230 4622 FORMAT(2X, 19A2) H4620240 WRITE (NWVI,4623) H4620250 4623 FORMAT(//29H TEST EMPTY FORMAT STATEMENT / H4620260 136H THE FOLLOWING LINE SHOULD BE BLANK ) H4620270 WRITE(NWVI,4624) H4620280 4624 FORMAT( ) H4620290 WRITE(NWVI,4625) H4620300 4625 FORMAT(23H END EMPTY FORMAT TEST //22H END SEGMENT 312 TEST ) H4620310 RETURN H4620320 END H4620330