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,SQRT                                         H0014940
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
