C***** PART11 ****************************************************H0004800 C***** H0004805 C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS H0004810 C***** H0004815 C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3 H0004820 C***** H0004825 C***** JUNE 1973 H0004830 C***** H0004835 C***** PART 11 OF 14 PARTS H0004840 C***** H0004845 C***** SEGMENTS INCLUDED H0004850 C***** H0004855 C***** DPFCP - 165 DOUBLE PRECISION FUNCTIONS H0004860 C***** H0004865 C***** AFD - 405 REAL ARGUMENT H0004870 C***** H0004875 C***** BFD - 415 INTEGER ARGUMENT H0004880 C***** H0004885 C***** CFD - 425 D.P. ARGUMENT H0004890 C***** H0004895 C***** DFD - 435 COMPLEX ARGUMENTS H0004900 C***** H0004905 C***** EFD - 445 LOGICAL ARGUMENT H0004910 C***** H0004915 C***** FFD - 455 EXTERNAL PROCEDURE H0004920 C***** H0004925 C***** GFD - 465 ARRAY NAME H0004930 C***** H0004935 C***** HFD - 475 DIFFERENT TYPES OF ARGUMENTS H0004940 C***** H0004945 C***** BFCCP - 166 LOGICAL FUNCTIONS H0004950 C***** H0004955 C***** AFB - 406 REAL ARGUMENT H0004960 C***** H0004965 C***** BFB - 416 INTEGER ARGUMENT H0004970 C***** H0004975 C***** CFB - 426 D.P. ARGUMENT H0004980 C***** H0004985 C***** DFB - 436 LOGICAL ARGUMENT H0004990 C***** H0004995 C***** EFB - 446 COMPLEX ARGUMENT H0005000 C***** H0005005 C***** FFB - 456 ARRAY NAME H0005010 C***** H0005015 C***** GFB - 466 EXTERNAL PROCEDURE H0005020 C***** H0005025 C***** HFB - 476 DIFFERENT TYPES OF ARGUMENTS H0005030 C***** H0005035 C***** SBRTN - 167 SUBROUTINE SUBPROGRAM H0005040 C***** H0005045 C***** AAQ - 407 INTEGER AND REAL VARIABLES AND ARRAY ELEMENTS H0005050 C***** H0005055 C***** ABQ - 417 ARRAY ELEMENTS H0005060 C***** H0005065 C***** ACQ - 427 NO ARGUMENT LIST H0005070 C***** H0005075 C***** FSBRT - 168 SUBROUTINE SUBPROGRAM H0005080 C***** H0005085 C***** ADQ - 408 DIFFERENT TYPES OF ARGUMENTS H0005090 C***** H0005095 C***** AEQ - 418 ARRAY NAMES AND INTEGER ARGUMENTS H0005100 C***** H0005105 C***** AFQ - 428 NO ARGUMENT LIST H0005110 C***** H0005115 C***** BLKDT - 169 BLOCK DATA H0005120 C***** H0005125 C***** BLOKD - 409 BLOCK DATA SUBPROGRAM H0005130 C***** H0014800 C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN H0014805 C***** SEGMENTS 165, 166, 167, 168, 169 ARE RUN AS ONE MAIN PROGRAM. H0014810 C***** H0014815 DIMENSION A1S(5), A2S(2,2), A3S(3,3,3) H0014820 DIMENSION IAB1I(4), IAB2I(3,3), IAB3I(2,2,2), AB1S(4) H0014825 1 ,AB2S(3,3), AB3S(2,2,2) H0014830 INTEGER I1I(5), I2I(2,2), I3I(2,2,2) H0014835 DOUBLE PRECISION AVD, A1D(4),A2D(2,2),A3D(2,2,2) H0014840 DOUBLE PRECISION AFD,BFD,CFD,DFD,EFD,FFD,GFD,HFD H0014845 DOUBLE PRECISION AXVD, AX1D, AX2D,AX3D H0014850 1 ,DXVD,DX1D,DX2D,DX3D H0014855 LOGICAL A1B(2), A2B(2,2), A3B(2,2,2),AXVB, AX1B, AX2B, AX3B,AVB H0014860 1 ,BVB,AFB,BFB,CFB,DFB,EFB,FFB,GFB,HFB , DXVB,DX1B,DX2B,DX3B H0014865 COMPLEX AVC,A1C(12),A2C(2,2), A3C(2,2,1) H0014870 COMPLEX AXVC, AX1C, AX2C, AX3C,DXVC, DX1C, DX2C, DZ3C H0014875 COMMON AXVS,CXVS H0014880 COMMON IXVI,IAX1I(4),IAX2I(3,3),IAX3I(2,2,2),BXVS, H0014885 - AX1S(4),AX2S(3,3),AX3S(2,2,2),AXVD,AX1D(2),AX2D(2,2), H0014890 B AX3D(2,2,2), AXVC, AX1C(2), AX2C(2,2), AX3C(2,2,2), AXVB, H0014895 C AX1B(2), AX2B(2,2), AX3B(2,2,2) H0014900 COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H0014905 A /BLK2/DXVS, DX1S(2), DX2S(2,2) H0014910 B /BLK3/DXVD, DX1D(2), DX2D(2,2) H0014915 C /BLK4/DXVC, DX1C(2), DX2C(2,2) H0014920 D /BLK5/DXVB, DX1B(2), DX2B(2,2) H0014925 E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2), H0014930 F DZ3C(2,2,2), DX3B(2,2,2) H0014935 EXTERNAL AFB,CFD,AFD H0014940 INTRINSIC SQRT C***** END OF SPECIFICATIONS FOR SEGMENTS H0014945 C***** 165, 166, 167, 168, 169 H0014950 C***** H0014955 C***********************************************************************H1650010 C***** H1650020 C***** DPFCP-(165) H1650030 C***** H1650040 C***********************************************************************H1650050 C***** GENERAL PURPOSE H1650060 C***** 1.TO TEST DOUBLE PRECISION FUNCTIONS IN FULL FORTRAN 8.3.1H1650070 C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL, H1650080 C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME H1650090 C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS H1650100 C***** 4.IN REFERENCE,ACTUAL ARGUMENTS ARE VARIABLE1NAME, H1650110 C***** ARRAY NAME,ARRAY ELEMENT NAME,OR ARITHMETIC EXPRESSION. 8.3.2H1650120 C*****RESTRICTIONS OBSERVED H1650130 C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1 H1650140 C***** 2 LAST SENTENCE OF PARAGRAPH 3.2 H1650150 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1650160 C***** 405, 415, 425, 435, 445, 455, 465, 475 WHICH H1650170 C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE H1650180 C***** H1650190 C***** S P E C I F I C A T I O N S SEGMENT 165 H1650200 C***** H0014960 C***** WHEN EXECUTING ONLY SEGMENT 165, REMOVE THE PRECEDING H0014965 C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH H0014970 C***** APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.H0014975 C***** H0014980 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3) H0014985 C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2) H0014990 C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB,BVB H0014995 C= DOUBLE PRECISION AFD, BFD, CFD, DFD, EFD, FFD, GFD, HFD,AVD H0015000 C= 1, A1D(4),A2D(2,2),A3D(2,2,2) H0015005 C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1) H0015010 C= COMMON AXVS,CXVS H0015015 C= EXTERNAL CFD,AFD H0015020 C***** H0015025 C***** I N P U T O U T P U T T A P E ASSIGNMENT STATEMENTS H1650210 IRVI = 5 H0074800 NUVI = 6 H0074805 C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS H0074810 WRITE(NUVI,0071) H0074815 0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S// H0074820 1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS// H0074825 3 37H FOR USE ON LARGE FORTRAN PROCESSORS // H0074830 4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966// H0074835 5 23H VERSION 3 PART 11///) H0074840 C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER H0074845 C PREPARED BY USER H0074850 C READ, NO LIST H0074855 C PREPARED BY USER H0074860 C READ, NO LIST H0074865 C PREPARED BY USER H0074870 C READ, NO LIST H0074875 C READ(IRVI,0070) H0074880 C READ(IRVI,0072) H0074885 C READ(IRVI,0073) H0074890 0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /) H0074895 0072 FORMAT(40H TEST PROGRAMS /) H0074900 0073 FORMAT(40H FORTRAN COMPILER /) H0074905 WRITE(NUVI,0070) H0074910 WRITE(NUVI,0072) H0074915 WRITE(NUVI,0073) H0074920 C***** H0074925 WRITE (NUVI,1650) H1650220 1650 FORMAT(1H1,1X,30HDPFCP - (165) DOUBLE PRECISION/ 16X, 9HFUNCTIONS H1650230 1 //2X,21HASA REFS. 8.3.1,8.3.2//2X, 7HRESULTS) H1650240 C***** TEST 1 H1650250 MAVI = 1 H1650260 IVI = AFD(1.0) - 1.0D0 H1650270 IF (IVI) 1652,1653,1652 H1650280 C***** TEST 2 H1650290 1657 MAVI =2 H1650300 IVI=BFD(1)-1.0D0 H1650310 IF(IVI)1652,1653,1652 H1650320 C***** TEST 3 H1650330 1658 MAVI =3 H1650340 AVD=1.0D0 H1650350 IVI=CFD(AVD)-1.0D0 H1650360 IF(IVI) 1652,1653,1652 H1650370 C***** TEST 4 .ONE ARGUMENT IS ARRAY ELEMENT NAME H1650380 1659 MAVI =4 H1650390 AVC = (1.0,1.0) H1650400 A1C(1)=(1.0,-1.0) H1650410 IVI=DFD(AVC,A1C(1)) H1650420 IF (IVI) 1652,1653,1652 H1650430 C***** TEST 5,6 H1650440 7014 MAVI =5 H1650450 AVB=.TRUE. H1650460 IVI=EFD(AVB)-1.0D0 H1650470 IF(IVI)1652,1653,1652 H1650480 7015 MAVI = 6 H1650490 AVB=.FALSE. H1650500 IVI=EFD(AVB) H1650510 IF(IVI)1652,1653,1652 H1650520 C***** TEST 7 H1650530 7016 MAVI = 7 H1650540 IVI = FFD (1.E0,AFD) - 1.0D0 H1650550 IF (IVI) 1652,1653,1652 H1650560 C***** TEST 8 H1650570 7017 MAVI = 8 H1650580 A1D(1)=1.0D0 H1650590 A1D(2)=-1.0D0 H1650600 IVI=GFD(A1D) H1650610 IF (IVI) 1652,1653,1652 H1650620 C***** TESTS 9,10,11,12 H1650630 7018 IAVI = 1 H1650640 AVD=1.0D0 H1650650 A1D(1)=1.0D0 H1650660 A2D(1,1)=1.0D0 H1650670 A3D(1,1,1)= 1.0D0 H1650680 AVS=1.0 H1650690 A1S(1)=1.0 H1650700 A2S(1,1)=1.0 H1650710 A3S(1,1,1)=1.0 H1650720 A1C(1)=(1.0,1.0) H1650730 A2C(1,1)=(1.0,1.0) H1650740 A3C(1,1,1)=(1.0,1.0) H1650750 I1I(1)=1 H1650760 I2I(1,1)=1 H1650770 I3I(1,1,1)=1 H1650780 MAVI = 9 H1650790 IVI=HFD(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I ,A1B,A2B,A3B,H1650800 1A1C,A2C,A3C,A1D,A2D,A3D,CFD) H1650810 IF (IVI) 1652,1653,1652 H1650820 7019 MAVI = 10 H1650830 IVI=AXVS H1650840 IF (IVI) 1652,1653,1652 H1650850 7020 MAVI = 11 H1650860 WRITE (NUVI,1656) AVC,MAVI H1650870 1656 FORMAT(//2F5.1//2X,5HTEST ,I2,31H IS POSITIVE IF NUMBERS PRINTED/ H1650880 1 2X,17HABOVE ARE 0.0,0.0) H1650890 7021 MAVI = 12 H1650900 BVB = AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1) H1650910 IF(BVB) GO TO 1653 H1650920 1652 WRITE(NUVI,1654)MAVI H1650930 GO TO 1651 H1650940 1653 WRITE(NUVI,1655)MAVI H1650950 1654 FORMAT(/2X,5HTEST ,I2,12H IS NEGATIVE) H1650960 1655 FORMAT(/2X,5HTEST ,I2,12H IS POSITIVE) H1650970 1651 GO TO (1657,1658,1659,7014,7015,7016,7017,7018,7019,7020,7021, H1650980 1 7022) ,MAVI H1650990 7022 CONTINUE H1651000 C***** END OF TEST SEGMENT 165 H1651010 C***** WHEN EXECUTING ONLY SEGMENT 165, THE STOP AND END CARDS H1651020 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1651030 C***** IN COLUMNS 1 AND 2 REMOVED. H1651040 C= STOP H1651050 C= END H1651060 C***********************************************************************H1660010 C***** H1660020 C***** BFCCP-(166) H1660030 C***** H1660040 C***********************************************************************H1660050 C***** GENERAL PURPOSE H1660060 C***** 1.TO TEST LOGICAL FUNCTIONS IN FULL FORTRAN H1660070 C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL, H1660080 C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME. H1660090 C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS H1660100 C***** 4.IN REFERENCE ACTUAL ARGUMENTS ARE VARIABLE NAME H1660110 C***** ARRAY NAME,ARRAY ELEMENT NAME,ARITHMETIC EXPRESSION H1660120 C***** EXTERNAL PROCEDURE H1660130 C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENTION H1660140 C***** 7.ARGUMENTS CAN BE PASSED THROUGH COMMON H1660150 C*****RESTRICTIONS OBSERVED H1660160 C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH H1660170 C***** 2.LAST SENTENCE OF PARAGRAPH 3.2 H1660180 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1660190 C***** 406, 416, 426, 436, 446, 456, 466, 476 WHICH H1660200 C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE. H1660210 C*****LOGICAL FUNCTION OF REAL ARGUMENT(TEST 1) H1660220 C***** H1660230 C***** S P E C I F I C A T I O N S SEGMENT 166 H1660240 C***** H0015030 C***** WHEN EXECUTING ONLY SEGMENT 166, THE SPECIFICATION STATEMENTS H0015035 C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= H0015040 C***** IN COLUMNS 1 AND 2 REMOVED. H0015045 C***** H0015050 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3) H0015055 C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2) H0015060 C= LOGICAL AVB,AFB,BFB,CFB,DFB,EFB,FFB,GFB,HFB H0015065 C= 1, A1B(2),A2B(2,2),A3B(2,2,2) H0015070 C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2) H0015075 C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1) H0015080 C= COMMON AXVS,CXVS H0015085 C= EXTERNAL AFB H0015090 C***** H0015095 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1660250 C***** H0074930 C***** WHEN EXECUTING ONLY SEGMENT 166, THE FOLLOWING STATEMENT H0074935 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074940 C= NUVI = 6 H0074945 MAVI=1 H1660260 WRITE(NUVI,1662) H1660270 1662 FORMAT(1H1,1X,31HBFCCP - (166) LOGICAL FUNCTIONS//2X, H1660280 1 13HASA REF 8.3.1//2X,7HRESULTS) H1660290 AVB=AFB(1.0) H1660300 IF (AVB) GO TO 1664 H1660310 WRITE(NUVI,1661) MAVI H1660320 GO TO 1665 H1660330 1660 FORMAT (/7H TEST ,I2,12H IS POSITIVE) H1660340 1661 FORMAT (/7H TEST ,I2,12H IS NEGATIVE) H1660350 1664 WRITE(NUVI,1660) MAVI H1660360 GO TO (1665,1666,1667,1668,1669,7030,7031,7032,7033,7034), MAVI H1660370 C***** LOGICAL FUNCTION OF INTEGER ARGUMENT (TEST 2) H1660380 1665 MAVI=2 H1660390 AVB=BFB(1) H1660400 IF (AVB) GO TO 1664 H1660410 WRITE(NUVI,1661) MAVI H1660420 C*****LOGICAL FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3) H1660430 1666 MAVI=3 H1660440 AVD=1.0D0 H1660450 AVB=CFB(AVD) H1660460 IF (AVB) GO TO 1664 H1660470 WRITE(NUVI,1661) MAVI H1660480 C***** LOGICAL FUNCTION OF LOGICAL ARGUMENT(TEST 4) H1660490 1667 MAVI=4 H1660500 AVB=DFB(.TRUE.) H1660510 IF (AVB) GO TO 1664 H1660520 WRITE(NUVI,1661) MAVI H1660530 C*****LOGICAL FUNCTION OF COMPLEX ARGUMENT(TEST 5) H1660540 1668 MAVI=5 H1660550 AVB=EFB((1.0,1.0)) H1660560 IF (AVB) GO TO 1664 H1660570 WRITE(NUVI,1661) MAVI H1660580 C***** LOGICAL FUNCTION OF ARRAY NAME (TEST 6) H1660590 1669 MAVI=6 H1660600 A1S(1)=1.0 H1660610 A1S(2)=0.0 H1660620 AVB=FFB(A1S) H1660630 IF (AVB) GO TO 1664 H1660640 WRITE(NUVI,1661) MAVI H1660650 C***** LOGICAL FUNCTION OF EXTERNAL PROCEDURE(TEST 7) H1660660 7030 MAVI=7 H1660670 AVB= GFB(AFB,1.0) H1660680 IF (AVB) GO TO 1664 H1660690 WRITE(NUVI,1661) MAVI H1660700 C*****LOGICAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS H1660710 7031 MAVI=8 H1660720 AVD = 1.0D0 H1660730 AVC = (1.0,1.0) H1660740 IAVI = 1 H1660750 AVB=.TRUE. H1660760 A1B(1)=.TRUE. H1660770 A2B(1,1)=.TRUE. H1660780 A3B(1,1,1)=.TRUE. H1660790 A1C(1)=(1.0,1.0) H1660800 A2C(1,1)=(1.0,1.0) H1660810 A3C(1,1,1)=(-2.0,-2.0) H1660820 A1D(1)=1.0D0 H1660830 A2D(1,1)=1.0D0 H1660840 A3D(1,1,1)=-2.0D0 H1660850 I1I(1)=1 H1660860 I2I(1,1)=1 H1660870 I3I(1,1,1)=1 H1660880 A1S(1)=1.0 H1660890 A2S(1,1)=1.0 H1660900 A3S(1,1,1)=1.0 H1660910 AXVS=1.0 H1660920 AVB= HFB(AVS,IAVI,AVB,AVD,AVC,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B, H1660930 1A3B,A1C,A2C,A3C,A1D,A2D,A3D,AFB) H1660940 IF (AVB) GO TO 1664 H1660950 WRITE(NUVI,1661) MAVI H1660960 7032 MAVI = 9 H1660970 IAVI=AVD H1660980 IF(IAVI.EQ.0) GO TO 1664 H1660990 WRITE(NUVI,1661) MAVI H1661000 7033 IAVI=1 H1661010 MAVI=10 H1661020 IAVI=AVS H1661030 IF(IAVI.EQ.0) GO TO 1664 H1661040 WRITE(NUVI,1661) MAVI H1661050 7034 MAVI=11 H1661060 WRITE(NUVI,1663) AVC,MAVI H1661070 1663 FORMAT (//2F8.4//7H TEST ,I2,31H IS POSITIVE IF NUMBERS PRINTED/ H1661080 119H ABOVE ARE 0.0,0.0//2X,12HEND OF (166)) H1661090 C***** END OF TEST SEGMENT 166 H1661100 C***** WHEN EXECUTING ONLY SEGMENT 166, THE STOP AND END CARDS H1661110 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN H1661120 C***** COLUMNS 1 AND 2 REMOVED. H1661130 C= STOP H1661140 C= END H1661150 C***********************************************************************H1670010 C***** H1670020 C***** SBRTN - (167) H1670030 C***** H1670040 C***********************************************************************H1670050 C***** GENERAL PURPOSE ASA REFSH1670060 C***** TO TEST SUBROUTINE SUBPROGRAMS 8.4.1 H1670070 C***** RESTRICTIONS OBSERVED H1670080 C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.//19H1670090 C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE H1670100 C***** SUBROUTINE STATEMENT ITSELF H1670110 C***** * SYMBOLIC NAMES OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/23H1670120 C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM H1670130 C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.//29H1670140 C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT H1670150 C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE H1670160 C***** BEING DEFINED. H1670170 C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE H1670180 C***** 8.4.1.1/33H1670190 C***** GENERAL COMMENTS H1670200 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 407, 417, 427 H1670210 C***** H1670220 C***** S P E C I F I C A T I O N S SEGMENT 167 H1670230 C***** H0015100 C***** WHEN EXECUTING ONLY SEGMENT 167, THE SPECIFICATION STATEMENTS H0015105 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0015110 C***** IN COLUMNS 1 AND 2 REMOVED. H0015115 C***** H0015120 C= DIMENSION IAB1I(4), IAB2I(3,3), AB1S(4), AB2S(3,3) H0015125 C= COMMON AXVS, CXVS, IXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2), H0015130 C= 1 BXVS, AX1S(4), AX2S(3,3) H0015135 C= EXTERNAL SQRT H0015140 C***** H0015145 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1670240 C***** H0074950 C***** WHEN EXECUTING ONLY SEGMENT 167, THE FOLLOWING STATEMENT H0074955 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074960 C= NUVI = 6 H0074965 C***** H0074970 C***** WRITE HEADING H1670250 WRITE (NUVI,1670) H1670260 1670 FORMAT(1H1,1X,35HSBRTN - (167) SUBROUTINE SUBPROGRAM/ H1670270 1 /2X,16HASA REF. - 8.4.1//2X,7HRESULTS) H1670280 C***** SET ALL VARIABLES AND SOME ELEMENTS IN ARRAYS TO ZERO H1670290 IAVI = 4 H1670300 AVS = 0.0 H1670310 IAB1I(1) = 0 H1670320 IAB1I(3) = 0 H1670330 IAB2I(1,2) = 0 H1670340 IAB2I(3,3) = 0 H1670350 C***** H1670360 AB1S(1) = 0.0 H1670370 AB1S(4) = 0.0 H1670380 AB2S(1,3) = 0.0 H1670390 AB2S(2,3) = 0.0 H1670400 C***** H1670410 IXVI = 0 H1670420 BXVS = 0.0 H1670430 IAX1I(2) = 0 H1670440 IAX2I(1,2) = 0 H1670450 C***** H1670460 AX1S(2) = 0.0 H1670470 AX2S(1,2) = 0.0 H1670480 C***** H1670490 C***** SET ELEMENTS IN INTEGER AND REAL ARRAY TO 1 TO TEST H1670500 C***** EXPRESSIONS IN SUBROUTINE ARGUMENT H1670510 IAB1I(2) = 1 H1670520 IAB1I(4) = 1 H1670530 IAB2I(2,1) = 1 H1670540 IAB2I(2,2) = 1 H1670550 C***** H1670560 AB1S(2) = 1.0 H1670570 AB1S(3) = 1.0 H1670580 AB2S(1,2) = 1.0 H1670590 AB2S(2,2) = 1.0 H1670600 C***** H1670610 CALL AAQ(IAVI, AVS, IAB1I, IAB2I, AB1S, AB2S, SQRT, H1670620 1IAB1I(2)+IAB1I(4)*IAB2I(2,1)-IAB2I(2,2), H1670630 2AB1S(2)+AB1S(3)*AB2S(1,2)-AB2S(2,2),1.0) H1670640 CALL ACQ H1670650 C***** WRITE RESULTS H1670660 WRITE (NUVI,1671) IAVI, AVS, IAB1I(1), IAB1I(3), IAB2I(1,2), H1670670 A IAB2I(3,3), AB1S(1), AB1S(4), H1670680 B AB2S(1,3), AB2S(2,3), IXVI, BXVS, H1670690 C IAX1I(2), IAX2I(1,2), AX1S(2), H1670700 D AX2S(1,2) H1670710 1671 FORMAT (//I10/F11.1/4(I10/),4(F11.1/),I10/F11.1/2(I10/),2(F11.1/ H1670720 A)) H1670730 WRITE (NUVI,1672) H1670740 1672 FORMAT (//2X,38HTEST SUCCESSFUL IF ALL RESULTS EQUAL 1//) H1670750 C***** END OF TEST SEGMENT 167 H1670760 C***** WHEN EXECUTING ONLY SEGMENT 167, THE STOP AND END CARDS H1670770 C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C= H1670780 C***** IN COLUMNS 1 AND 2 REMOVED. H1670790 C= STOP H1670800 C= END H1670810 C***********************************************************************H1680010 C***** H1680020 C***** FSBRT - (168) H1680030 C***** H1680040 C***********************************************************************H1680050 C***** GENERAL PURPOSE ASA REFSH1680060 C***** TO TEST SUBROUTINE SUBPROGRAM IN FORTRAN 8.4.1 H1680070 C***** RESTRICTIONS OBSERVED H1680080 C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.1/56H1680090 C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE H1680100 C***** SUBROUTINE STATEMENT ITSELF. H1680110 C***** * SYMBOLIC NAME OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/39H1680120 C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM H1680130 C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.1/45H1680140 C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT H1680150 C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE H1680160 C***** BEING DEFINED. H1680170 C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE H1680180 C***** 8.4.1.1/49H1680190 C***** GENERAL COMMENTS H1680200 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 408 , 418, 428 H1680210 C***** H1680220 C***** S P E C I F I C A T I O N S SEGMENT 168 H1680230 C***** H0015150 C***** WHEN EXECUTING ONLY SEGMENT 168, THE SPECIFICATION STATEMENTS H0015155 C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= H0015160 C***** IN COLUMNS 1 AND 2 REMOVED. H0015165 C***** H0015170 C= DIMENSION IAB1I(4), IAB2I(3,3), IAB3I(2,2,2), AB1S(4), AB2S(3,3), H0015175 C= A AB3S(2,2,2) H0015180 C= COMMON AXVS, CXVS, IXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2), H0015185 C= A BXVS, AX1S(4), AX2S(3,3), AX3S(2,2,2), AXVD, AX1D(2), H0015190 C= B AX2D(2,2), AX3D(2,2,2), AXVC, AX1C(2), AX2C(2,2), H0015195 C= C AX3C(2,2,2), AXVB, AX1B(2), AX2B(2,2), AX3B(2,2,2) H0015200 C= DOUBLE PRECISION AXVD, AX1D, AX2D, AX3D H0015205 C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2) H0015210 C= COMPLEX AXVC, AX1C, AX2C, AX3C H0015215 C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1) H0015220 C= LOGICAL AXVB, AX1B, AX2B, AX3B H0015225 C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB H0015230 C***** H0015235 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1680240 C***** H0074975 C***** WHEN EXECUTING ONLY SEGMENT 168, THE FOLLOWING STATEMENT H0074980 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074985 C= NUVI = 6 H0074990 C***** SET INTEGER VARIABLES AND SOME ELEMENTS IN ARRAYS TO ZERO H1680250 C***** WRITE HEADING H1680260 WRITE (NUVI,1680) H1680270 1680 FORMAT (1H1,1X,36HFSBRT - (168) SUBROUTINE SUBPROGRAMS/ H1680280 A/18H ASA REF. - 8.4.1//2X,7HRESULTS) H1680290 IAVI = 0 H1680300 IAB1I(1) = 0 H1680310 IAB2I(1,2) = 0 H1680320 IAB3I(1,1,2) = 0 H1680330 IXVI = 0 H1680340 IAX1I(1) = 0 H1680350 IAX2I(1,2) = 0 H1680360 IAX3I(1,1,2) = 0 H1680370 C***** SET REAL VARIABLES AND SOME ELEMENTS IN ARRAYS TO ONE H1680380 AVS = 1. H1680390 AB1S(1) = 1. H1680400 AB2S(1,2) = 1. H1680410 AB3S(1,1,2) = 1. H1680420 BXVS = 1. H1680430 AX1S(2) = 1. H1680440 AX2S(1,2) = 1. H1680450 AX3S(1,1,2) = 1. H1680460 C***** SET DP VARIABLES AND SOME ELEMENTS IN ARRAY TO TWO H1680470 AVD = 2.0D0 H1680480 A1D(1) = 2.0D0 H1680490 A2D(1,2) = 2.0D0 H1680500 A3D(1,1,2) = 2.0D0 H1680510 AXVD = 2.0D0 H1680520 AX1D(1) = 2.0D0 H1680530 AX2D(1,2) = 2.D0 H1680540 AX3D(1,1,2) = 2.0D0 H1680550 C***** SET COMPLEX VARIABLES AND SOME ELEMENTS IN ARRAYS TO (3.0,3.0)H1680560 AVC = (3.0,3.0) H1680570 A1C(1) = (3.0,3.0) H1680580 A2C(1,2) = (3.0,3.0) H1680590 A3C(1,2,1) = (3.0,3.0) H1680600 AXVC = (3.0,3.0) H1680610 AX1C(1) = (3.0,3.0) H1680620 AX2C(1,2) = (3.0,3.0) H1680630 AX3C(1,1,2) = (3.0,3.0) H1680640 C***** SET LOGICAL VARIABLES AND SOME ELEMENTS IN ARRAYS TO .FALSE. H1680650 AVB = .FALSE. H1680660 A1B(1) = .FALSE. H1680670 A2B(1,2) = .FALSE. H1680680 A3B(1,1,2) = .FALSE. H1680690 AXVB = .FALSE. H1680700 AX1B(1) = .FALSE. H1680710 AX2B(1,2) = .FALSE. H1680720 AX3B(1,1,2) = .FALSE. H1680730 C***** SET INTEGER AND REAL VARIABLES FOR EXPRESSION USAGE IN H1680740 C***** DUMMY ARGUMENT H1680750 IAB1I(4) = 0 H1680760 IAB1I(2) = 0 H1680770 AB1S(4) = 0.0 H1680780 AB1S(2) = 0.0 H1680790 JAVI = 1 H1680800 KAVI = 1 H1680810 LAVI = 1 H1680820 MAVI = 1 H1680830 NAVI = 1 H1680840 ABVS = 1. H1680850 ACVS = 1. H1680860 ADVS = 2. H1680870 AEVS = 2. H1680880 AFVS = 2. H1680890 CALL ADQ(IAVI,IAB1I, IAB2I, IAB3I, AVS, AB1S, AB2S, AB3S, AVD, H1680900 A A1D, A2D, A3D, AVC, A1C, A2C, A3C, AVB, A1B, A2B, A3B, H1680910 B JAVI+KAVI*LAVI-MAVI/NAVI,1,ABVS+ACVS*ADVS-AEVS/AFVS,2.) H1680920 WRITE (NUVI,1681) H1680930 CALL AFQ H1680940 1681 FORMAT ( /28H TEST IS SUCCESSFUL IF EACH/ H1680950 A28H GROUP CONTAINS SAME VALUES) H1680960 WRITE (NUVI,1682) IAVI, IAB1I(1), IAB1I(2), IAB1I(4), IAB2I(1,2), H1680970 A IAB3I(1,1,2), IXVI, IAX1I(1), IAX2I(1,2), H1680980 B IAX3I(1,1,2), AVS, AB1S(1), AB2S(1,2), AB3S(1,1,H1680990 C2),AB1S(2),AB1S(4), BXVS, AX1S(2), AX2S(1,2), AX3S(1,1,2), AVD, H1681000 D A1D(1), A2D(1,2), A3D(1,1,2), AXVD, AX1D(1), H1681010 E AX2D(1,2), AX3D(1,1,2), AVC, A1C(1), A2C(1,2), H1681020 F A3C(1,2,1), AXVC, AX1C(1), AX2C(1,2), H1681030 G AX3C(1,1,2), AVB, A1B(1), A2B(1,2), A3B(1,1,2), H1681040 H AXVB, AX1B(1), AX2B(1,2), AX3B(1,1,2) H1681050 1682 FORMAT ( 10(I10/)/ H1681060 1 10(F11.1/)/ H1681070 2 8(1PD15.1/)/ H1681080 3 8(0PF5.1,F5.1/)/ H1681090 4 8(L10/) ) H1681100 C***** END OF TEST SEGMENT 168 H1681110 C***** WHEN EXECUTING ONLY SEGMENT 168, THE STOP AND END CARDS H1681120 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN H1681130 C***** COLUMNS 1 AND 2 REMOVED. H1681140 C= STOP H1681150 C= END H1681160 C***********************************************************************H1690010 C***** H1690020 C***** BLKDT - (169) H1690030 C***** H1690040 C***********************************************************************H1690050 C***** GENERAL PURPOSE ASA REFSH1690060 C***** TO TEST BLOCK DATA SUBPROGRAM 8.5 H1690070 C***** GENERAL COMMENTS H1690080 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 409. THIS H1690090 C***** SEGMENT WRITES OUT THE DATA FORMED IN SEGMENT 409. H1690100 C***** H1690110 C***** S P E C I F I C A T I O N S SEGMENT 169 H1690120 C***** H0015240 C***** WHEN EXECUTING ONLY SEGMENT 169, THE SPECIFICATION STATEMENTS H0015245 C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= H0015250 C***** IN COLUMNS 1 AND 2 REMOVED. H0015255 C***** H0015260 C= COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H0015265 C= A /BLK2/DXVS, DX1S(2), DX2S(2,2) H0015270 C= B /BLK3/DXVD, DX1D(2), DX2D(2,2) H0015275 C= C /BLK4/DXVC, DX1C(2), DX2C(2,2) H0015280 C= D /BLK5/DXVB, DX1B(2), DX2B(2,2) H0015285 C= E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2), H0015290 C= F DZ3C(2,2,2), DX3B(2,2,2) H0015295 C= DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D H0015300 C= COMPLEX DXVC, DX1C, DX2C, DZ3C H0015305 C= LOGICAL DXVB, DX1B, DX2B, DX3B H0015310 C***** H0015315 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1690130 C***** H0074995 C***** WHEN EXECUTING ONLY SEGMENT 169, THE FOLLOWING STATEMENT H0075000 C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0075005 C= NUVI = 6 H0075010 C***** WRITE HEADING FOR SEGMENT 169 H1690140 WRITE (NUVI,1690) H1690150 1690 FORMAT (1H1,1X,35HBLKDT - (169) BLOCK DATA SUBPROGRAM// H1690160 A16H ASA REF. - 8.5//2X,7HRESULTS) H1690170 WRITE (NUVI,1691) H1690180 1691 FORMAT ( /28H TEST IS SUCCESSFUL IF EACH/ H1690190 A28H GROUP CONTAINS SAME VALUES) H1690200 WRITE (NUVI,1692) JAX2I(1,1), JAX1I(2), JAX2I(2,1), JAX3I(2,2,1) H1690210 A ,DX3S(1,2,1), DX1S(1), DX2S(1,1), DX3S(2,2,1), DX2D(2,2) H1690220 B ,DX1D(2), DX2D(2,1), DX3D(2,2,1), DX2C(2,2), DX1C(2) H1690230 C ,DX2C(2,1), DZ3C(2,1,1), DX2B(2,2), DX1B(2), DX2B(2,1) H1690240 D ,DX3B(2,2,1), JAX2I(3,1), H1690250 E DX3B(2,1,2), DX2S(2,2) H1690260 1692 FORMAT (// 4(I10/)// H1690270 A 4(F12.1/)// H1690280 B 4(1PD16.1/)// H1690290 C 4(0PF6.1,F6.1/)// H1690300 D 4(L10/)// H1690310 F 3(2H ,A2/)) H1690320 C***** END OF TEST SEGMENT 169 H1690330 C***** WHEN EXECUTING ONLY SEGMENT 169, THE STOP AND END CARDS H1690340 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN H1690350 C***** COLUMNS 1 AND 2 REMOVED. H1690360 C= STOP H1690370 C= END H1690380 STOP H9999995 END H9999999 C***********************************************************************H4050010 C***** H4050020 C***** AFD - (405) H4050030 C***** H4050040 C***********************************************************************H4050050 C*****DOUBLE PRECISION FUNCTION OF REAL ARGUMENT (TEST 1) H4050060 DOUBLE PRECISION FUNCTION AFD(AWVS) H4050070 AFD=AWVS H4050080 RETURN H4050090 END H4050100 C***********************************************************************H4150010 C***** H4150020 C***** BFD -(415) H4150030 C***** H4150040 C***********************************************************************H4150050 C*****DOUBLE PRECISION FUNCTION OF INTEGER ARGUMENT(TEST2) H4150060 DOUBLE PRECISION FUNCTION BFD(IWVI) H4150070 BFD=1.0D0**IWVI H4150080 RETURN H4150090 END H4150100 C***********************************************************************H4250010 C***** H4250020 C***** CFD - (425) H4250030 C***** H4250040 C***********************************************************************H4250050 C*****DOUBLE PRECISION FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3) H4250060 DOUBLE PRECISION FUNCTION CFD(AWVD) H4250070 DOUBLE PRECISION AWVD H4250080 CFD=AWVD H4250090 RETURN H4250100 END H4250110 C***********************************************************************H4350010 C***** H4350020 C***** DFD -(435) H4350030 C***** H4350040 C***********************************************************************H4350050 C*****DOUBLE PRECISION FUNCTION OF COMPLEX ARGUMENT(TEST 4) H4350060 DOUBLE PRECISION FUNCTION DFD(AWVC,BWVC) H4350070 COMPLEX AWVC,BWVC,CVC H4350080 CVC =BWVC*AWVC H4350090 DFD=AIMAG(CVC) H4350100 RETURN H4350110 END H4350120 C***********************************************************************H4450010 C***** H4450020 C***** EFD - (445) H4450030 C***** H4450040 C***********************************************************************H4450050 C*****DOUBLE PRECISION FUNCTION OF LOGICAL ARGUMENT(TEST 5,6) H4450060 DOUBLE PRECISION FUNCTION EFD(AWVB) H4450070 LOGICAL AWVB H4450080 IF(AWVB) GO TO 4451 H4450090 4450 IF(.NOT.AWVB) GO TO 4452 H4450100 RETURN H4450110 4451 EFD = 1.0D0 H4450120 GO TO 4450 H4450130 4452 EFD = 0.0D0 H4450140 RETURN H4450150 END H4450160 C***********************************************************************H4550010 C***** H4550020 C***** FFD - (455) H4550030 C***** H4550040 C***********************************************************************H4550050 C*****DOUBLE PRECISION FUNCTION OF EXTERNAL PROCEDURE (TEST 7) H4550060 DOUBLE PRECISION FUNCTION FFD(BWVS,BWFD) H4550070 DOUBLE PRECISION BWFD H4550080 FFD = BWFD (BWVS) H4550090 RETURN H4550100 END H4550110 C***********************************************************************H4650010 C***** H4650020 C***** GFD - (465) H4650030 C***** H4650040 C***********************************************************************H4650050 C*****DOUBLE PRECISION FUNCTION OF ARRAY NAME (TEST 8) H4650060 DOUBLE PRECISION FUNCTION GFD(AW1D) H4650070 DIMENSION AW1D(2) H4650080 DOUBLE PRECISION AW1D H4650090 GFD= AW1D(1)+AW1D(2) H4650100 RETURN H4650110 END H4650120 C***** H4750010 C***** H4750020 C***** HFD - (475) H4750030 C***** H4750040 C***********************************************************************H4750050 C*****DOUBLE PRECISION FUNCTION OF DIFFERENT TYPES OF ARGUMENTS.USE CAN H4750060 C*****BE MADE OF ADJUSTABLE DIMENSION.SOME ARGUMENTS CAN BE PASSED H4750070 C*****THROUGH A COMMON STATEMENT. H4750080 DOUBLE PRECISION FUNCTION HFD(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S, H4750090 1 AW3S,IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D, H4750100 2 AW3D,CWFD) H4750110 DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI), H4750120 1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI), H4750130 2 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI), H4750140 3 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI), H4750150 4 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI) H4750160 DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D, CWFD H4750170 COMPLEX AWVC,AW1C,AW2C,AW3C H4750180 REAL AW1S, AW2S, AW3S H4750190 LOGICAL AWVB,AW1B,AW2B,AW3B H4750200 COMMON BXVS H4750210 HFD = AWVD - AW1D(IWVI)+AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI) H4750220 1 + CWFD(AWVD) - 1.0D0 H4750230 AWVC=AW1C(IWVI)+AW2C(IWVI,IWVI)-AW3C(IWVI,IWVI,IWVI)-(1.0,1.0) H4750240 BXVS=AWVS**IWVI-AW1S(IWVI)**IW1I(IWVI)+AW2S(IWVI,IWVI)**IW2I H4750250 1 (IWVI,IWVI)-AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI) H4750260 AWVB=IWVI.EQ.1 H4750270 AW1B(IWVI)=IWVI.EQ.1 H4750280 AW2B(IWVI,IWVI)=IWVI.EQ.1 H4750290 AW3B(IWVI,IWVI,IWVI)=IWVI.EQ.1 H4750300 RETURN H4750310 END H4750320 C***********************************************************************H4060010 C***** H4060020 C***** AFB - (406) H4060030 C***** H4060040 C***********************************************************************H4060050 C*****LOGICAL FUNCTION OF REAL ARGUMENT (TEST 1) H4060060 LOGICAL FUNCTION AFB(AWVS) H4060070 AFB= AWVS.GT.0.0 H4060080 RETURN H4060090 END H4060100 C***********************************************************************H4160010 C***** H4160020 C***** BFB - (416) H4160030 C***** H4160040 C***********************************************************************H4160050 C*****LOGICAL FUNCTION OF INTEGER ARGUMENT (TEST 2) H4160060 LOGICAL FUNCTION BFB(IWVI) H4160070 BFB= IWVI.GT.0 H4160080 RETURN H4160090 END H4160100 C***********************************************************************H4260010 C***** H4260020 C***** CFB - (426) H4260030 C***** H4260040 C***********************************************************************H4260050 C*****LOGICAL FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3) H4260060 LOGICAL FUNCTION CFB(AWVD) H4260070 DOUBLE PRECISION AWVD H4260080 CFB= AWVD.GT.0.0D0 H4260090 RETURN H4260100 END H4260110 C***********************************************************************H4360010 C***** H4360020 C***** DFB - (436) H4360030 C***** H4360040 C***********************************************************************H4360050 C*****LOGICAL FUNCTION OF LOGICAL ARGUMENT (TEST 4) H4360060 LOGICAL FUNCTION DFB(AWVB) H4360070 LOGICAL AWVB H4360080 DFB=AWVB H4360090 RETURN H4360100 END H4360110 C***********************************************************************H4460010 C***** H4460020 C***** EFB - (446) H4460030 C***** H4460040 C***********************************************************************H4460050 C*****LOGICAL FUNCTION OF COMPLEX ARGUMENT (TEST 5) H4460060 LOGICAL FUNCTION EFB(AWVC) H4460070 COMPLEX AWVC H4460080 AVS =AIMAG(AWVC) H4460090 EFB = AVS .GT.0.0 H4460100 RETURN H4460110 END H4460120 C***********************************************************************H4560010 C***** H4560020 C***** FFB - (456) H4560030 C***** H4560040 C***********************************************************************H4560050 C*****LOGICAL FUNCTION OF ARRAY NAME (TEST 6) H4560060 LOGICAL FUNCTION FFB(AW1S) H4560070 DIMENSION AW1S(2) H4560080 BVS =AW1S(1)+AW1S(2) H4560090 FFB= BVS .GT.0.0 H4560100 RETURN H4560110 END H4560120 C***********************************************************************H4660010 C***** H4660020 C***** GFB - (466) H4660030 C***** H4660040 C***********************************************************************H4660050 C*****LOGICAL FUNCTION OF EXTERNAL PROCEDURE (TEST 7) H4660060 LOGICAL FUNCTION GFB(AWFB,AWVS) H4660070 LOGICAL AWFB H4660080 GFB= AWFB(AWVS) H4660090 RETURN H4660100 END H4660110 C***********************************************************************H4760010 C***** H4760020 C***** HFB - (476) H4760030 C***** H4760040 C***********************************************************************H4760050 C*****LOGICAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 8,9,10,11) H4760060 LOGICAL FUNCTION HFB(AWVS,IWVI,AWVB,AWVD,AWVC,AW1S,AW2S,AW3S, H4760070 1IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFB) H4760080 COMMON BXVS H4760090 COMPLEX AWVC,AW1C,AW2C,AW3C H4760100 DOUBLE PRECISION AWVD,AW1D,AW3D, AW2D H4760110 LOGICAL AWVB,AW1B,AW2B,AW3B,AWFB H4760120 DIMENSION AW1C(IWVI),AW2C(IWVI,2),AW3C(IWVI,2,2), H4760130 1 AW1B(IWVI),AW2B(IWVI,2),AW3B(IWVI,2,2) , H4760140 2 AW1S(IWVI),AW2S(IWVI,2),AW3S(IWVI,2,2) , H4760150 3 AW1D(IWVI),AW2D(IWVI,2),AW3D(IWVI,2,2) , H4760160 4 IW1I(IWVI),IW2I(IWVI,2),IW3I(IWVI,2,2) H4760170 HFB = AWVB.AND.AW1B(IWVI).AND.AW2B(IWVI,IWVI).AND.AW3B(IWVI, H4760180 1 IWVI,IWVI).AND.AWFB(1.0) H4760190 AWVC=AW1C(IWVI)+AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI) H4760200 AWVD=AW1D(IWVI)+AW2D(IWVI,IWVI)+AW3D(IWVI,IWVI,IWVI) H4760210 AWVS=BXVS+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I(IWVI,IWVI) H4760220 1 -AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI) H4760230 RETURN H4760240 END H4760250 C***********************************************************************H4070010 C***** H4070020 C***** AAQ - (407) H4070030 C***** H4070040 C***********************************************************************H4070050 C***** THIS SUBROUTINE IS TO BE RUN WITH SEGMENT 167 H4070060 SUBROUTINE AAQ (IWVI, AWVS, IAW1I, IAW2I, AW1S, AW2S, SQFI, H4070070 1MWVI, BWVS, CWVS) H4070080 DIMENSION IAW1I(4), IAW2I(3,3), AW1S(4), H4070090 1 AW2S(3,3) H4070100 IWVI = INT(SQFI(FLOAT(IWVI) + .5)) - 1 H4070110 AWVS = AWVS + 1.0 H4070120 IAVI = 5 H4070130 IAW1I(1) = MWVI H4070140 IAW1I(3) = IAW1I(3) + 1 H4070150 IAW2I(3,3) = IAW2I(3,3) + 1 H4070160 AW1S(1) = BWVS H4070170 AW2S(1,3) = CWVS H4070180 C***** H4070190 C***** CALL A SUBROUTINE FROM ANOTHER SUBROUTINE H4070200 CALL ABQ(IAW2I, AW1S, AW2S) H4070210 RETURN H4070220 END H4070230 C***********************************************************************H4170010 C***** H4170020 C***** ABQ - (417) H4170030 C***** H4170040 C***********************************************************************H4170050 SUBROUTINE ABQ(ICW2I, CW1S, CW2S) H4170060 DIMENSION ICW2I(3,3), CW1S(4), CW2S(3,3) H4170070 ICW2I(1,2) = ICW2I(1,2) + 1 H4170080 C***** H4170090 CW1S(4) = CW1S(4) + 1.0 H4170100 CW2S(2,3) = CW2S(2,3) + 1.0 H4170110 RETURN H4170120 END H4170130 C***********************************************************************H4270010 C***** H4270020 C***** ACQ - (427) H4270030 C***** H4270040 C***********************************************************************H4270050 SUBROUTINE ACQ H4270060 DIMENSION IDX1I(4), IDX2I(3,3), IDX3I(2,2,2) H4270070 1 ,AAX1S(4), AAX2S(3,3) H4270080 COMMON ABXVS, ACXVS, IAXVI, IDX1I, IDX2I, IDX3I, H4270090 1 AAXVS, AAX1S, AAX2S H4270100 IAXVI = IAXVI+1 H4270110 AAXVS = AAXVS +1.0 H4270120 IDX1I(2) = IDX1I(2) + 1 H4270130 IDX2I(1,2) = IDX2I(1,2) + 1 H4270140 C***** H4270150 AAX1S(2) = AAX1S(2) * 2. + 1.0 H4270160 AAX2S(1,2) = AAX2S(1,2) + 4.0 - 3.0 H4270170 C***** H4270180 RETURN H4270190 C***** END OF TEST SEGMENT 427 H4270200 END H4270210 C***********************************************************************H4080010 C***** H4080020 C***** ADQ - (408) H4080030 C***** H4080040 C***********************************************************************H4080050 C***** SUBROUTINE ADQ CALLED BY SEG. FSBRT(168) H4080060 SUBROUTINE ADQ(IWVI,IAW1I,IAW2I,IAW3I,AWVS,AW1S,AW2S,AW3S, H4080070 A AWVD,AW1D,AW2D,AW3D,AWVC,AW1C,AW2C,AW3C, H4080080 B AWVB,AW1B,AW2B,AW3B,KWVI,MWVI,BWVS,CWVS) H4080090 DIMENSION IAW1I(4), IAW2I(3,3), IAW3I(2,2,2), AW1S(4), AW2S(3,3), H4080100 A AW3S(2,2,2), AW1D(2), AW2D(2,2), AW3D(2,2,2), AW1C(2), H4080110 B AW2C(2,2), AW3C(2,2,1), AW1B(2), AW2B(2,2), H4080120 C AW3B(2,2,2) H4080130 DOUBLE PRECISION AWVD, AW1D, AW2D, AW3D H4080140 COMPLEX AWVC, AW1C, AW2C, AW3C H4080150 LOGICAL AWVB, AW1B, AW2B, AW3B H4080160 C***** STORE INTEGER AND REAL EXPRESSIONS H4080170 IAW1I(4) = KWVI H4080180 IAW1I(2) = MWVI H4080190 AW1S(4) = BWVS H4080200 AW1S(2) = CWVS H4080210 CALL AEQ (IWVI,IAW1I,IAW2I,IAW3I,AWVS,AW1S,AW2S,AW3S) H4080220 C***** INCREMENT DOUBLE PRECISION H4080230 AWVD = AWVD + AWVD H4080240 AW1D(1) = AW1D(1) + AW1D(1) H4080250 AW2D(1,2) = AW2D(1,2) + AW2D(1,2) H4080260 AW3D(1,1,2) = AW3D(1,1,2) + AW3D(1,1,2) H4080270 C***** INCREMENT COMPLEX H4080280 AWVC = AWVC + AWVC H4080290 AW1C(1) = AW1C(1) + AW1C(1) H4080300 AW2C(1,2) = AW2C(1,2) + AW2C(1,2) H4080310 AW3C(1,2,1) = AW3C(1,2,1) + AW3C(1,2,1) H4080320 C***** CHANGE LOGICAL H4080330 AWVB = .NOT. AWVB H4080340 AW1B(1) = .NOT. AW1B(1) H4080350 AW2B(1,2) = .NOT. AW2B(1,2) H4080360 AW3B(1,1,2) = .NOT. AW3B(1,1,2) H4080370 RETURN H4080380 END H4080390 C***********************************************************************H4180010 C***** H4180020 C***** AEQ - (418) H4180030 C***** H4180040 C***********************************************************************H4180050 C***** SUBROUTINE AEQ CALLED BY SEG ADQ(408) WHICH IS H4180060 C***** CALLED BY SEG. FSBRT(168) H4180070 SUBROUTINE AEQ(KWVI, KAW1I, KAW2I, KAW3I, AAWVS, AAW1S, AAW2S, H4180080 A AAW3S) H4180090 DIMENSION KAW1I(4),KAW2I(3,3),KAW3I(2,2,2),AAW1S(4),AAW2S(3,3), H4180100 A AAW3S(2,2,2) H4180110 C***** INCREMENT INTEGERS H4180120 KWVI = KWVI + 1 H4180130 KAW1I(1) = KAW1I(1) + 1 H4180140 KAW2I(1,2) = KAW2I(1,2) + 1 H4180150 KAW3I(1,1,2) = KAW3I(1,1,2)+1 H4180160 C***** INCREMENT REAL H4180170 AAWVS = AAWVS + 1. H4180180 AAW1S(1) = AAW1S(1) + 1. H4180190 AAW2S(1,2) = AAW2S(1,2) + 1. H4180200 AAW3S(1,1,2) = AAW3S(1,1,2) + 1. H4180210 RETURN H4180220 END H4180230 C***********************************************************************H4280010 C***** H4280020 C***** AFQ - (428) H4280030 C***** H4280040 C***********************************************************************H4280050 C***** SUBROUTINE AFQ CALLED BY SEG. FSBRT(168) H4280060 SUBROUTINE AFQ H4280070 COMMON ABXVS, ACXVS, IAXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2), H4280080 A AXVS, AX1S(4), AX2S(3,3), AX3S(2,2,2), AXVD, AX1D(2), H4280090 2 AX2D(2,2), AX3D(2,2,2),AXVC, AX1C(2), AX2C(2,2), AX3C(2,2,2)H4280100 3 ,AXVB, AX1B(2), AX2B(2,2), AX3B(2,2,2) H4280110 DOUBLE PRECISION AXVD, AX1D, AX2D, AX3D H4280120 COMPLEX AXVC, AX1C, AX2C, AX3C H4280130 LOGICAL AXVB, AX1B, AX2B, AX3B H4280140 C***** SET INTEGERS TO 1 H4280150 IAXVI = 1 H4280160 IAX1I(1) = 1 H4280170 IAX2I(1,2) = 1 H4280180 IAX3I(1,1,2) = 1 H4280190 C***** SET REAL TO 2 H4280200 AXVS = 2. H4280210 AX1S(2) = 2. H4280220 AX2S(1,2) = 2. H4280230 AX3S(1,1,2) = 2. H4280240 C***** SET DP TO 4 H4280250 AXVD = 4.0D0 H4280260 AX1D(1) = 4.0D0 H4280270 AX2D(1,2) = 4.0D0 H4280280 AX3D(1,1,2) = 4.0D0 H4280290 C***** SET COMPLEX TO 6 H4280300 AXVC = (6.0,6.0) H4280310 AX1C(1) = (6.0,6.0) H4280320 AX2C(1,2) = (6.0,6.0) H4280330 AX3C(1,1,2) = (6.0,6.0) H4280340 C***** CHANGE LOGICAL H4280350 AXVB = .TRUE. H4280360 AX1B(1) = .TRUE. H4280370 AX2B(1,2) = .TRUE. H4280380 AX3B(1,1,2) = .TRUE. H4280390 RETURN H4280400 END H4280410 C***********************************************************************H4090010 C***** H4090020 C***** BLOKD - (409) H4090030 C***** H4090040 C***********************************************************************H4090050 C***** GENERAL PURPOSE H4090060 C***** THIS SEGMENT CONTAINS ONE BLOCK DATA SUBPROGRAM. H4090070 C***** IT IS TO BE RUN WITH SEGMENT 169 H4090080 C***** GENERAL COMMENTS H4090090 C***** THIS SEGMENT USES ALL THE PERMISSIBLE STATEMENTS IN A H4090100 C***** BLOCK DATA SUBPROGRAM. THE DATA STATEMENT CONSISTS OF ALL H4090110 C***** TYPES OF VARIABLES AND ARRAYS. A HOLLERITH CONSTANT H4090120 C***** IS ASSIGNED TO INTEGER, REAL AND LOGICAL H4090130 BLOCK DATA H4090140 COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3) H4090150 A /BLK2/DXVS, DX1S(2), DX2S(2,2) H4090160 B /BLK3/DXVD, DX1D(2), DX2D(2,2) H4090170 C /BLK4/DXVC, DX1C(2), DX2C(2,2) H4090180 D /BLK5/DXVB, DX1B(2), DX2B(2,2) H4090190 E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2), H4090200 F DZ3C(2,2,2), DX3B(2,2,2) H4090210 DIMENSION CY3C(2,2,2) H4090220 DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D H4090230 COMPLEX DXVC, DX1C, DX2C, DZ3C, CY3C H4090240 LOGICAL DXVB, DX1B, DX2B, DX3B H4090250 INTEGER JXVI H4090260 REAL DXVS H4090270 EQUIVALENCE (DZ3C(1,1,1), CY3C(1,1,1)) H4090280 DATA JAX2I(1,1), JAX1I(2), JAX2I(2,1), JAX3I(2,2,1),DX3S(1,2,1), H4090290 A DX1S(1), DX2S(1,1), DX3S(2,2,1), DX2D(2,2), DX1D(2), H4090300 B DX2D(2,1), DX3D(2,2,1), DX2C(2,2), DX1C(2), DX2C(2,1), H4090310 C DZ3C(2,1,1), DX2B(2,2), DX1B(2), DX2B(2,1), DX3B(2,2,1), H4090320 D JAX2I(3,1),DX3B(2,1,2),DX2S(2,2)/4*2,4*3.0,4*4.0D0,4*(4.,5.),H4090330 E 4*.TRUE., 2HAB, 2HAB, 2HAB/ H4090340 C***** END OF TEST SEGMENT 409 H4090350 END H4090360