      PROGRAM FM500

C***********************************************************************00010500
C*****  FORTRAN 77                                                      00020500
C*****   FM500                                                          00030500
C*****                       BLKD1 - (260)                              00040500
C*****   THIS PROGRAM USES SN501 AND AN502                              00050500
C***********************************************************************00060500
C*****  TESTING OF BLOCK DATA SUBPROGRAMS FEATURES              ANS REF 00070500
C*****          IMPLICIT, PARAMETER, EXTERNAL, AND SAVE           16    00080500
C*****  THIS SEGMENT USES  BLOCK DATA PROGRAM                           00090500
C*****  AN502    AND SUBROUTINE SN501                                   00100500
C*****                                                                  00110500
C*****  S P E C I F I C A T I O N S  SEGMENT 260                        00120500
        EXTERNAL AN502                                                  00130500
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00140500
C*****  PARAMETER (KPI = 2, LPI = 10)                                   00150500
C*****  INTEGER FXVI                                                    00160500
C*****  REAL JX1S                                                       00170500
C*****  DOUBLE PRECISION AX1D, BX4D                                     00180500
C*****  DIMENSION BX4D(KPI, KPI, KPI, KPI)                              00190500
C*****  COMPLEX AXVC, BX1C, CZ5C                                        00200500
C*****  LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)                           00210500
C*****  CHARACTER*1 A1XVK, B1X1K, C1X7K                                 00220500
C*****  CHARACTER*2 D2Z1K                                               00230500
C*****  CHARACTER*4 E4XVK, G4X2K                                        00240500
C*****  CHARACTER*(LPI) I10XVK                                          00250500
C*****                                                                  00260500
C*****  COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)         00270500
C*****  COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00280500
C*****  COMMON /BLK3/ RXVD, AX1D(2), BX4D                               00290500
C*****  COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)                    00300500
C*****  COMMON /BLK5/ AXVB, BZ1B(2), CX6B                               00310500
C*****  COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),            00320500
C*****                S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK        00330500
C*****                                                                  00340500
        CALL SN501                                                      00350500
        STOP                                                            00360500
C*****          END OF TEST SEGMENT 260                                 00370500
        END                                                             00380500

C***********************************************************************00010501
C***** FORTRAN 77                                                       00020501
C*****   FM501                  SN501    - (251)                        00030501
C*****   THIS SUBROUTINE IS CALLED BY PROGRAM FM500                     00040501
C***********************************************************************00050501
C*****                                                                  00060501
C***** GENERAL PURPOSE                                                  00070501
C*****  THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250                 00080501
C*****     THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF     00090501
C*****  IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY        00100501
C*****  VARIABLES                                                       00110501
C*****                                                                  00120501
CBB** ********************** BBCCOMNT **********************************00130501
C****                                                                   00140501
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00150501
C****                          VERSION 2.1                              00160501
C****                                                                   00170501
C****                                                                   00180501
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00190501
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00200501
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00210501
C****                      BUILDING 225  RM A266                        00220501
C****                     GAITHERSBURG, MD  20899                       00230501
C****                                                                   00240501
C****                                                                   00250501
C****                                                                   00260501
CBE** ********************** BBCCOMNT **********************************00270501
        SUBROUTINE SN501                                                00280501
C*****                                                                  00290501
        IMPLICIT INTEGER (H)                                            00300501
        IMPLICIT DOUBLE PRECISION (R)                                   00310501
        IMPLICIT CHARACTER*2 (S)                                        00320501
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00330501
        PARAMETER (KPI = 2, LPI = 10)                                   00340501
        INTEGER FXVI                                                    00350501
        REAL JX1S                                                       00360501
        DOUBLE PRECISION AX1D, BX4D, DVCORR                             00370501
        DIMENSION BX4D(KPI, KPI, KPI, KPI)                              00380501
        COMPLEX AXVC, BX1C, CZ5C                                        00390501
        LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)                           00400501
        CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01                         00410501
        CHARACTER*2 D2Z1K, CVNC02                                       00420501
        CHARACTER*4 E4XVK, G4X2K, CVNC04                                00430501
        CHARACTER*(LPI) I10XVK, CVNC10                                  00440501
C*****                                                                  00450501
        COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)         00460501
        COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00470501
        COMMON /BLK3/ RXVD, AX1D(2), BX4D                               00480501
        COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)                    00490501
        COMMON /BLK5/ AXVB, BZ1B(2), CX6B                               00500501
        COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),            00510501
     1          S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK              00520501
C*****                                                                  00530501
        SAVE/BLK6/                                                      00540501
C*****                                                                  00550501
        EQUIVALENCE (NYVI, EZVS)                                        00560501
C*****  LOCAL DECLARATIONS                                              00570501
        DOUBLE PRECISION AVD                                            00580501
        COMPLEX AVC                                                     00590501
C*****    O U T P U T  T A P E  ASSIGNMENT STATEMENT.  NO INPUT TAPE.   00600501
CBB** ********************** BBCINITA **********************************00610501
C**** SPECIFICATION STATEMENTS                                          00620501
C****                                                                   00630501
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00640501
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00650501
CBE** ********************** BBCINITA **********************************00660501
CBB** ********************** BBCINITB **********************************00670501
C**** INITIALIZE SECTION                                                00680501
      DATA  ZVERS,                  ZVERSD,             ZDATE           00690501
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00700501
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00710501
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00720501
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00730501
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00740501
      DATA   REMRKS /'                               '/                 00750501
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00760501
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00770501
C****                                                                   00780501
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00790501
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00800501
CZ03  ZPROG  = 'PROGRAM NAME'                                           00810501
CZ04  ZDATE  = 'DATE OF TEST'                                           00820501
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00830501
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00840501
CZ07  ZNAME  = 'NAME OF USER'                                           00850501
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00860501
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00870501
C                                                                       00880501
      IVPASS = 0                                                        00890501
      IVFAIL = 0                                                        00900501
      IVDELE = 0                                                        00910501
      IVINSP = 0                                                        00920501
      IVTOTL = 0                                                        00930501
      IVTOTN = 0                                                        00940501
      ICZERO = 0                                                        00950501
C                                                                       00960501
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00970501
      I01 = 05                                                          00980501
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00990501
      I02 = 06                                                          01000501
C                                                                       01010501
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01020501
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      01030501
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     01040501
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  01050501
C                                                                       01060501
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     01070501
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       01080501
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     01090501
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  01100501
C                                                                       01110501
CBE** ********************** BBCINITB **********************************01120501
           NWVI = I02                                                   01130501
           IVTOTL = 37                                                  01140501
           ZPROG='FM500'                                                01150501
CBB** ********************** BBCHED0A **********************************01160501
C****                                                                   01170501
C**** WRITE REPORT TITLE                                                01180501
C****                                                                   01190501
      WRITE (I02, 90002)                                                01200501
      WRITE (I02, 90006)                                                01210501
      WRITE (I02, 90007)                                                01220501
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01230501
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01240501
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01250501
CBE** ********************** BBCHED0A **********************************01260501
C*****                                                                  01270501
           WRITE(NWVI,26000)                                            01280501
26000   FORMAT( / " BLKD1 - (260) BLOCK DATA SUBPROGRAMS --" /          01290501
     1          "  IMPLICIT, PARAMETER, EXTERNAL, SAVE" //              01300501
     2          "  ANS REF. - 16" )                                     01310501
C*****                                                                  01320501
CBB** ********************** BBCHED0B **********************************01330501
C**** WRITE DETAIL REPORT HEADERS                                       01340501
C****                                                                   01350501
      WRITE (I02,90004)                                                 01360501
      WRITE (I02,90004)                                                 01370501
      WRITE (I02,90013)                                                 01380501
      WRITE (I02,90014)                                                 01390501
      WRITE (I02,90015) IVTOTL                                          01400501
CBE** ********************** BBCHED0B **********************************01410501
C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1                        01420501
C**** REPLACE THE DELETE COMMENT WITH DELETE CODE                       01430501
CT001*  TEST 1                                 INTEGER VARIABLE         01440501
           IVTNUM=1                                                     01450501
           WRITE (NWVI,70140)                                           01460501
           IVCORR=5                                                     01470501
40010   IF (IXVI - 5) 20010,10010,20010                                 01480501
10010      IVPASS=IVPASS+1                                              01490501
           WRITE (NWVI,80002) IVTNUM                                    01500501
           GO TO 0011                                                   01510501
20010      IVFAIL=IVFAIL+1                                              01520501
           WRITE (NWVI,80008) IVTNUM                                    01530501
           WRITE (NWVI,80024) IXVI                                      01540501
           WRITE (NWVI,80026) IVCORR                                    01550501
 0011      CONTINUE                                                     01560501
CT002*  TEST 2                         INTEGER DECLARE VARIABLE         01570501
           IVTNUM = 2                                                   01580501
           IVCORR=6                                                     01590501
        IF (FXVI - 6) 20020,10020,20020                                 01600501
10020      IVPASS=IVPASS+1                                              01610501
           WRITE (NWVI,80002) IVTNUM                                    01620501
           GO TO 0021                                                   01630501
20020      IVFAIL=IVFAIL+1                                              01640501
           WRITE (NWVI,80008) IVTNUM                                    01650501
           WRITE (NWVI,80024) FXVI                                      01660501
           WRITE (NWVI,80026) IVCORR                                    01670501
 0021      CONTINUE                                                     01680501
CT003*  TEST 3                                    INTEGER ARRAY         01690501
           IVTNUM = 3                                                   01700501
           IVCORR=8                                                     01710501
        IF (KX1I(2) - 8) 20030,10030,20030                              01720501
10030      IVPASS=IVPASS+1                                              01730501
           WRITE (NWVI,80002) IVTNUM                                    01740501
           GO TO 0031                                                   01750501
20030      IVFAIL=IVFAIL+1                                              01760501
           WRITE (NWVI,80008) IVTNUM                                    01770501
           WRITE (NWVI,80024) KX1I(2)                                   01780501
           WRITE (NWVI,80026) IVCORR                                    01790501
 0031      CONTINUE                                                     01800501
CT004*  TEST 4                           IMPLICIT INTEGER ARRAY         01810501
           IVTNUM = 4                                                   01820501
           IVCORR=1                                                     01830501
        IF (HX2I(1,2) - 1) 20040,10040,20040                            01840501
10040      IVPASS=IVPASS+1                                              01850501
           WRITE (NWVI,80002) IVTNUM                                    01860501
           GO TO 0041                                                   01870501
20040      IVFAIL=IVFAIL+1                                              01880501
           WRITE (NWVI,80008) IVTNUM                                    01890501
           WRITE (NWVI,80024) HX2I(1,2)                                 01900501
           WRITE (NWVI,80026) IVCORR                                    01910501
 0041      CONTINUE                                                     01920501
CT005*  TEST 5                                                          01930501
           IVTNUM = 5                                                   01940501
           IVCORR=5                                                     01950501
        IF (HX2I(2,2) - 5) 20050,10050,20050                            01960501
10050      IVPASS=IVPASS+1                                              01970501
           WRITE (NWVI,80002) IVTNUM                                    01980501
           GO TO 0051                                                   01990501
20050      IVFAIL=IVFAIL+1                                              02000501
           WRITE (NWVI,80008) IVTNUM                                    02010501
           WRITE (NWVI,80024) HX2I(2,2)                                 02020501
           WRITE (NWVI,80026) IVCORR                                    02030501
 0051      CONTINUE                                                     02040501
CT006*  TEST 6                      DO INITIALIZE INTEGER ARRAY         02050501
           IVTNUM = 6                                                   02060501
           IVINSP=IVINSP+1                                              02070501
           WRITE (NWVI,80004) IVTNUM                                    02080501
        DO 70101 KVI = 1, 2                                             02090501
        IVI = MX2I(KVI, KVI) - 4                                        02100501
           WRITE (NWVI, 70100) IVI                                      02110501
70101      CONTINUE                                                     02120501
CT007*  TEST 7                                    REAL VARIABLE         02130501
           IVTNUM = 7                                                   02140501
           RVCORR=5.3                                                   02150501
           RVCOMP=0.0                                                   02160501
        RVCOMP=AXVS - 5.3                                               02170501
           IF (RVCOMP + .00005) 20070,10070,40070                       02180501
40070      IF (RVCOMP - .00005) 10070,10070,20070                       02190501
10070      IVPASS=IVPASS+1                                              02200501
           WRITE (NWVI,80002) IVTNUM                                    02210501
           GO TO 0071                                                   02220501
20070      IVFAIL=IVFAIL+1                                              02230501
           WRITE (NWVI,80008) IVTNUM                                    02240501
           WRITE (NWVI,80028) AXVS                                      02250501
           WRITE (NWVI,80030) RVCORR                                    02260501
 0071      CONTINUE                                                     02270501
CT008*  TEST 8                          EXTENDED PRECISION REAL         02280501
           IVTNUM = 8                                                   02290501
        AVS = BXVS - 1.23456789012345                                   02300501
           RVCOMP=1.23456789012345                                      02310501
           IF (AVS + .00005) 20080,10080,40080                          02320501
40080      IF (AVS - .00005) 10080,10080,20080                          02330501
10080      IVPASS=IVPASS+1                                              02340501
           WRITE (NWVI,80002) IVTNUM                                    02350501
           GO TO 0081                                                   02360501
20080      IVFAIL=IVFAIL+1                                              02370501
           WRITE (NWVI,80004) IVTNUM                                    02380501
70080      FORMAT (" ",16X,"COMPUTED: " ,E20.14)                        02390501
           WRITE (NWVI,70080) BXVS                                      02400501
70081      FORMAT (" ",16X,"CORRECT:  " ,E20.14)                        02410501
           WRITE (NWVI, 70081) RVCOMP                                   02420501
 0081      CONTINUE                                                     02430501
CT009*  TEST 9                              DECLARED REAL ARRAY         02440501
           IVTNUM = 9                                                   02450501
           RVCORR=2.45                                                  02460501
           RVCOMP=2.0                                                   02470501
        RVCOMP=(JX1S(1) - 2.45)                                         02480501
           IF (RVCOMP + .00005) 20090,10090,40090                       02490501
40090      IF (RVCOMP - .00005) 10090,10090,20090                       02500501
10090      IVPASS=IVPASS+1                                              02510501
           WRITE (NWVI,80002) IVTNUM                                    02520501
           GO TO 0091                                                   02530501
20090      IVFAIL=IVFAIL+1                                              02540501
           WRITE (NWVI,80008) IVTNUM                                    02550501
           WRITE (NWVI,80028) JX1S(1)                                   02560501
           WRITE (NWVI,80030) RVCORR                                    02570501
 0091      CONTINUE                                                     02580501
CT010*  TEST 10                                                         02590501
           IVTNUM = 10                                                  02600501
           RVCORR=4.58                                                  02610501
           RVCOMP=2.0                                                   02620501
        RVCOMP=(JX1S(2) - 4.58)                                         02630501
40100      IF (RVCOMP + .00005) 20100,10100,40101                       02640501
40101      IF (RVCOMP - .00005) 10100,10100,20100                       02650501
10100      IVPASS=IVPASS+1                                              02660501
           WRITE (NWVI,80002)                                           02670501
           GO TO 0100                                                   02680501
20100      IVFAIL=IVFAIL+1                                              02690501
           WRITE (NWVI,80008) IVTNUM                                    02700501
           WRITE (NWVI,80028) JX1S(2)                                   02710501
           WRITE (NWVI,80030) RVCORR                                    02720501
 0100      CONTINUE                                                     02730501
CT011*  TEST 11                          REAL ARRAY - NAME ONLY         02740501
           IVTNUM = 11                                                  02750501
           IVINSP=IVINSP+1                                              02760501
           WRITE (NWVI,80004) IVTNUM                                    02770501
        DO 70103 KVI = 1, 2                                             02780501
        AVS = CX2S(KVI, KVI) - 1.2                                      02790501
           WRITE (NWVI, 70102) AVS                                      02800501
70103      CONTINUE                                                     02810501
CT012*  TEST 12                         EQUIVALENCED REAL ARRAY         02820501
           IVTNUM = 12                                                  02830501
           IVINSP=IVINSP+1                                              02840501
           WRITE (NWVI,80004) IVTNUM                                    02850501
        DO 70104 KVI=1,2                                                02860501
        AVS = DZ3S(KVI, KVI, KVI) - 1.1                                 02870501
           WRITE (NWVI, 70102) AVS                                      02880501
70104      CONTINUE                                                     02890501
CT013*  TEST 13            REAL VARIABLE - EQUIVALENCED INTEGER         02900501
           IVTNUM = 13                                                  02910501
           IVCORR=34                                                    02920501
      IVI = NYVI - 34                                                   02930501
40130      IF (IVI  - 0) 20130,10130,20130                              02940501
10130      IVPASS=IVPASS+1                                              02950501
           WRITE (NWVI,80002) IVTNUM                                    02960501
           GO TO 0131                                                   02970501
20130      IVFAIL=IVFAIL+1                                              02980501
           WRITE (NWVI,80008) IVTNUM                                    02990501
           WRITE (NWVI,80028) NYVI                                      03000501
           WRITE (NWVI,80026) IVCORR                                    03010501
 0131      CONTINUE                                                     03020501
CT014*  TEST 14                          DOUBLE PRECISION ARRAY         03030501
           IVTNUM = 14                                                  03040501
        KVI=1                                                           03050501
        AVD = AX1D(KVI) - 1.456D3                                       03060501
           DVCORR=1.456D3                                               03070501
           IF (AVD + .0000000005) 20140,40141,40140                     03080501
40140      IF (AVD - .0000000005) 40141,40141,20140                     03090501
40141 KVI=2                                                             03100501
      AVD = AX1D(KVI) - 1.456D3                                         03110501
           IF (AVD + .0000000005) 20140,10140,40142                     03120501
40142      IF (AVD - .0000000005) 10140,10140,20140                     03130501
10140      IVPASS=IVPASS+1                                              03140501
           WRITE (NWVI,80002) IVTNUM                                    03150501
           GO TO 0141                                                   03160501
20140      IVFAIL=IVFAIL+1                                              03170501
           WRITE (NWVI,80008) IVTNUM                                    03180501
           WRITE (NWVI, 80033) AX1D(KVI)                                03190501
           WRITE (NWVI,80035) DVCORR                                    03200501
 0141      CONTINUE                                                     03210501
CT015*  TEST 15                DIMENSION DOUBLE PRECISION ARRAY         03220501
           IVTNUM = 15                                                  03230501
        AVD = BX4D(1,2,1,1) - 34.9D8                                    03240501
           IF (AVD + .0000000005) 20150,10150,40150                     03250501
40150      IF (AVD - .0000000005) 10150,10150,20150                     03260501
10150      IVPASS=IVPASS+1                                              03270501
           WRITE (NWVI,80002) IVTNUM                                    03280501
           GO TO 0151                                                   03290501
20150      IVFAIL=IVFAIL+1                                              03300501
           DVCORR=34.9D8                                                03310501
           WRITE (NWVI,80008) IVTNUM                                    03320501
           WRITE (NWVI, 80033) BX4D(1,2,1,1)                            03330501
           WRITE (NWVI,80035) DVCORR                                    03340501
 0151      CONTINUE                                                     03350501
CT016*  TEST 16                                                         03360501
           IVTNUM = 16                                                  03370501
           DVCORR=0.00                                                  03380501
        AVD = BX4D(1,2,1,2) - 2.123D0                                   03390501
           IF (AVD + .0000000005) 20160,10160,40160                     03400501
40160      IF (AVD - .0000000005) 10160,10160,20160                     03410501
10160      IVPASS=IVPASS+1                                              03420501
           WRITE (NWVI,80002) IVTNUM                                    03430501
           GO TO 0161                                                   03440501
20160      IVFAIL=IVFAIL+1                                              03450501
           DVCORR=2.123D0                                               03460501
           WRITE (NWVI,80008) IVTNUM                                    03470501
           WRITE (NWVI, 80033) BX4D(1,2,1,2)                            03480501
           WRITE (NWVI,80035) DVCORR                                    03490501
 0161      CONTINUE                                                     03500501
CT017*  TEST 17                                                         03510501
           IVTNUM = 17                                                  03520501
           DVCORR=0.00                                                  03530501
        AVD = BX4D(2,1,1,2) - 873.84D-1                                 03540501
           IF (AVD + .0000000005) 20170,10170,40170                     03550501
40170      IF (AVD - .0000000005) 10170,10170,20170                     03560501
10170      IVPASS=IVPASS+1                                              03570501
           WRITE (NWVI,80002) IVTNUM                                    03580501
           GO TO 0171                                                   03590501
20170      IVFAIL=IVFAIL+1                                              03600501
           WRITE (NWVI,80008) IVTNUM                                    03610501
           DVCORR=873.84D-1                                             03620501
           WRITE (NWVI, 80033) BX4D(2,1,1,2)                            03630501
           WRITE (NWVI,80035) DVCORR                                    03640501
 0171      CONTINUE                                                     03650501
CT018*  TEST 18                                COMPLEX VARIABLE         03660501
           IVTNUM = 18                                                  03670501
        AVC = AXVC - (1.5, 2.3)                                         03680501
           IVINSP=IVINSP+1                                              03690501
           WRITE (NWVI,80004) IVTNUM                                    03700501
           WRITE (NWVI,70107) AVC                                       03710501
CT019*  TEST 19                                   COMPLEX ARRAY         03720501
           IVTNUM = 19                                                  03730501
        AVC = BX1C(1) - (1.1, 1.2)                                      03740501
           IVINSP=IVINSP+1                                              03750501
           WRITE (NWVI,80004) IVTNUM                                    03760501
           WRITE (NWVI, 70107) AVC                                      03770501
CT020*  TEST 20                                                         03780501
           IVTNUM = 20                                                  03790501
        AVC = BX1C(2) - (3.2, 2.3)                                      03800501
           IVINSP=IVINSP+1                                              03810501
           WRITE (NWVI,80004) IVTNUM                                    03820501
           WRITE (NWVI, 70107) AVC                                      03830501
CT021*  TEST 21                     COMPLEX ARRAY - EQUIVALENCE         03840501
           IVTNUM = 21                                                  03850501
        AVC = CZ5C(1,1,1,2,1) - (1.2, 2.1)                              03860501
           IVINSP=IVINSP+1                                              03870501
           WRITE (NWVI,80004) IVTNUM                                    03880501
           WRITE (NWVI, 70107) AVC                                      03890501
CT022*  TEST 22                                                         03900501
           IVTNUM = 22                                                  03910501
        AVC = CZ5C(1,2,1,1,2) - (45.3, 2.1)                             03920501
           IVINSP=IVINSP+1                                              03930501
           WRITE (NWVI,80004) IVTNUM                                    03940501
           WRITE (NWVI, 70107) AVC                                      03950501
CT023*  TEST 23                                                         03960501
           IVTNUM = 23                                                  03970501
        AVC = CZ5C(2,1,1,1,2) - (309.89, 102.1)                         03980501
           IVINSP=IVINSP+1                                              03990501
           WRITE (NWVI,80004) IVTNUM                                    04000501
           WRITE (NWVI, 70107) AVC                                      04010501
CT024*  TEST 24                                LOGICAL VARIABLE         04020501
           IVTNUM = 24                                                  04030501
           IVCOMP=0                                                     04040501
        IF (AXVB) IVCOMP=1                                              04050501
40240      IF (IVCOMP-1) 20240,10240,20240                              04060501
10240      IVPASS=IVPASS+1                                              04070501
           WRITE (NWVI,80002) IVTNUM                                    04080501
           GO TO 0241                                                   04090501
20240      IVFAIL=IVFAIL+1                                              04100501
           WRITE (NWVI,80008) IVTNUM                                    04110501
 0241      CONTINUE                                                     04120501
CT025*  TEST 25                     LOGICAL ARRAY - EQUIVALENCE         04130501
           IVTNUM = 25                                                  04140501
           IVCOMP=0                                                     04150501
        IF (.NOT. BZ1B(2)) IVCOMP=1                                     04160501
40250      IF (IVCOMP-1) 20250,10250,20250                              04170501
10250      IVPASS=IVPASS+1                                              04180501
           WRITE (NWVI,80002) IVTNUM                                    04190501
           GO TO 0251                                                   04200501
20250      IVFAIL=IVFAIL+1                                              04210501
           WRITE (NWVI,80008) IVTNUM                                    04220501
 0251      CONTINUE                                                     04230501
CT026*  TEST 26                          DECLARED LOGICAL ARRAY         04240501
           IVTNUM = 26                                                  04250501
           IVCOMP=0                                                     04260501
        IF (CX6B(1,1,1,2,2,1)) IVCOMP=1                                 04270501
40260      IF (IVCOMP-1) 20260,10260,20260                              04280501
10260      IVPASS=IVPASS+1                                              04290501
           WRITE (NWVI,80002) IVTNUM                                    04300501
           GO TO 0261                                                   04310501
20260      IVFAIL=IVFAIL+1                                              04320501
           WRITE (NWVI,80008) IVTNUM                                    04330501
 0261      CONTINUE                                                     04340501
CT027*  TEST 27                            1 CHARACTER VARIABLE         04350501
           IVTNUM = 27                                                  04360501
           CVNC01='A'                                                   04370501
           IVCOMP=0                                                     04380501
        IF (A1XVK .EQ. 'A') IVCOMP=1                                    04390501
40270      IF (IVCOMP-1) 20270,10270,20270                              04400501
10270      IVPASS=IVPASS+1                                              04410501
           WRITE (NWVI,80002) IVTNUM                                    04420501
           GO TO 0271                                                   04430501
20270      IVFAIL=IVFAIL+1                                              04440501
           WRITE (NWVI,80008) IVTNUM                                    04450501
           WRITE (NWVI,80020) A1XVK                                     04460501
           WRITE (NWVI,80022) CVNC01                                    04470501
 0271      CONTINUE                                                     04480501
CT028*  TEST 28                               1 CHARACTER ARRAY         04490501
           IVTNUM = 28                                                  04500501
           CVNC01='K'                                                   04510501
           IVCOMP=0                                                     04520501
        IF (B1X1K(1) .EQ. 'K') IVCOMP=1                                 04530501
40280      IF (IVCOMP-1) 20280,10280,20280                              04540501
10280      IVPASS=IVPASS+1                                              04550501
           WRITE (NWVI,80002) IVTNUM                                    04560501
           GO TO 0281                                                   04570501
20280      IVFAIL=IVFAIL+1                                              04580501
           WRITE (NWVI,80008) IVTNUM                                    04590501
           WRITE (NWVI,80020) B1X1K(1)                                  04600501
           WRITE (NWVI,80022) CVNC01                                    04610501
 0281      CONTINUE                                                     04620501
CT029*  TEST 29                                                         04630501
           IVTNUM = 29                                                  04640501
           CVNC01='K'                                                   04650501
           IVCOMP=0                                                     04660501
        IF (B1X1K(2) .EQ. 'K') IVCOMP=1                                 04670501
           IF (IVCOMP-1) 20290,10290,20290                              04680501
10290      IVPASS=IVPASS+1                                              04690501
           WRITE (NWVI,80002) IVTNUM                                    04700501
           GO TO 0291                                                   04710501
20290      IVFAIL=IVFAIL+1                                              04720501
           WRITE (NWVI,80008) IVTNUM                                    04730501
           WRITE (NWVI,80020) B1X1K(2)                                  04740501
           WRITE (NWVI,80022) CVNC01                                    04750501
 0291      CONTINUE                                                     04760501
CT030*  TEST 30                   7 DIMENSION 1 CHARACTER ARRAY         04770501
           IVTNUM = 30                                                  04780501
           CVNC01='X'                                                   04790501
           IVCOMP=0                                                     04800501
        KVI=1                                                           04810501
        IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1       04820501
40300      IF(IVCOMP-1) 20300,40301,20300                               04830501
40301   KVI=2                                                           04840501
           IVCOMP=0                                                     04850501
        IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1       04860501
40302      IF (IVCOMP-1) 20300,40303,20300                              04870501
40303      IVPASS=IVPASS+1                                              04880501
           WRITE (NWVI,80002) IVTNUM                                    04890501
           GO TO 0301                                                   04900501
20300      IVFAIL=IVFAIL+1                                              04910501
           WRITE (NWVI,80008) IVTNUM                                    04920501
           WRITE (NWVI,80020) C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI)        04930501
           WRITE (NWVI,80022) CVNC01                                    04940501
 0301      CONTINUE                                                     04950501
CT031*  TEST 31                   IMPLICIT 2 CHARACTER VARIABLE         04960501
           IVTNUM = 31                                                  04970501
           CVNC02='.,'                                                  04980501
           IVCOMP=0                                                     04990501
        IF (S2XVK .EQ. '.,') IVCOMP=1                                   05000501
40310      IF (IVCOMP-1) 20310,10310,20310                              05010501
10310      IVPASS=IVPASS+1                                              05020501
           WRITE (NWVI,80002) IVTNUM                                    05030501
           GO TO 0311                                                   05040501
20310      IVFAIL=IVFAIL+1                                              05050501
           WRITE (NWVI,80008) IVTNUM                                    05060501
           WRITE (NWVI,80020) S2XVK                                     05070501
           WRITE (NWVI,80022) CVNC02                                    05080501
 0311      CONTINUE                                                     05090501
CT032*  TEST 32                2 CHARACTER ARRAY - EQUIVALENCED         05100501
           IVTNUM = 32                                                  05110501
           CVNC02='TE'                                                  05120501
           IVCOMP=0                                                     05130501
        IF (D2Z1K(1) .EQ. 'TE') IVCOMP=1                                05140501
40320      IF (IVCOMP-1) 20320,10320,20320                              05150501
10320      IVPASS=IVPASS+1                                              05160501
           WRITE (NWVI,80002) IVTNUM                                    05170501
           GO TO 0321                                                   05180501
20320      IVFAIL=IVFAIL+1                                              05190501
           WRITE (NWVI,80008) IVTNUM                                    05200501
           WRITE (NWVI,80020) D2Z1K(1)                                  05210501
           WRITE (NWVI,80022) CVNC02                                    05220501
 0321      CONTINUE                                                     05230501
CT033*  TEST 33                                                         05240501
           IVTNUM = 33                                                  05250501
           CVNC02='ST'                                                  05260501
           IVCOMP=0                                                     05270501
        IF (D2Z1K(2) .EQ. 'ST') IVCOMP=1                                05280501
40330      IF (IVCOMP-1) 20330,10330,20330                              05290501
10330      IVPASS=IVPASS+1                                              05300501
           WRITE (NWVI,80002) IVTNUM                                    05310501
           GO TO 0331                                                   05320501
20330      IVFAIL=IVFAIL+1                                              05330501
           WRITE (NWVI,80008) IVTNUM                                    05340501
           WRITE (NWVI,80020) D2Z1K(2)                                  05350501
           WRITE (NWVI,80022) CVNC02                                    05360501
 0331      CONTINUE                                                     05370501
CT034*  TEST 34                   DECLARED 4 CHARACTER VARIABLE         05380501
           IVTNUM = 34                                                  05390501
           CVNC04='ZXCV'                                                05400501
           IVCOMP=0                                                     05410501
        IF (E4XVK .EQ. 'ZXCV') IVCOMP=1                                 05420501
40340      IF (IVCOMP-1) 20340,10340,20340                              05430501
10340      IVPASS=IVPASS+1                                              05440501
           WRITE (NWVI,80002) IVTNUM                                    05450501
           GO TO 0341                                                   05460501
20340      IVFAIL=IVFAIL+1                                              05470501
           WRITE (NWVI,80008) IVTNUM                                    05480501
           WRITE (NWVI,80020) E4XVK                                     05490501
           WRITE (NWVI,80022) CVNC04                                    05500501
 0341      CONTINUE                                                     05510501
CT035*  TEST 35                      DECLARED 4 CHARACTER ARRAY         05520501
           IVTNUM = 35                                                  05530501
           CVNC02='SO'                                                  05540501
           IVCOMP=0                                                     05550501
        IF (G4X2K(1,1) .EQ. 'SO') IVCOMP=1                              05560501
40350      IF (IVCOMP-1) 20350,10350,20350                              05570501
10350      IVPASS=IVPASS+1                                              05580501
           WRITE (NWVI,80002) IVTNUM                                    05590501
           GO TO 0351                                                   05600501
20350      IVFAIL=IVFAIL+1                                              05610501
           WRITE (NWVI,80008) IVTNUM                                    05620501
           WRITE (NWVI,80020) G4X2K(1,1)                                05630501
           WRITE (NWVI,80022) CVNC02                                    05640501
 0351      CONTINUE                                                     05650501
CT036*  TEST 36                                                         05660501
           IVTNUM = 36                                                  05670501
           CVNC02='OS'                                                  05680501
           IVCOMP=0                                                     05690501
      IF (G4X2K(2,1) .EQ. 'OS') IVCOMP=1                                05700501
40360      IF (IVCOMP-1) 20360,10360,20360                              05710501
10360      IVPASS=IVPASS+1                                              05720501
           WRITE (NWVI,80002) IVTNUM                                    05730501
           GO TO 0361                                                   05740501
20360      IVFAIL=IVFAIL+1                                              05750501
           WRITE (NWVI,80008) IVTNUM                                    05760501
           WRITE (NWVI,80020) G4X2K(2,1)                                05770501
           WRITE (NWVI,80022) CVNC02                                    05780501
 0361      CONTINUE                                                     05790501
CT037*  TEST 37            CHARACTER VARIABLE - PARAMTER LENGTH         05800501
           IVTNUM = 37                                                  05810501
           CVNC10='FINAL TEST'                                          05820501
           IVCOMP=0                                                     05830501
        IF (I10XVK .EQ. 'FINAL TEST') IVCOMP=1                          05840501
40370      IF (IVCOMP-1) 20370, 10370, 20370                            05850501
10370      IVPASS=IVPASS+1                                              05860501
           WRITE (NWVI,80002) IVTNUM                                    05870501
           GO TO 0371                                                   05880501
20370      IVFAIL=IVFAIL+1                                              05890501
           WRITE (NWVI,80008) IVTNUM                                    05900501
           WRITE (NWVI,80020) I10XVK                                    05910501
           WRITE (NWVI,80022) CVNC10                                    05920501
 0371      CONTINUE                                                     05930501
C*****                                                                  05940501
70100   FORMAT(" ",26X,I5)                                              05950501
70102   FORMAT(" ",26X,F7.2)                                            05960501
70106   FORMAT(" ",26X,F7.2)                                            05970501
70107   FORMAT(" ",26X,"(",F7.2,", ",F7.2,")",4X,"SHOULD BE ZERO" )     05980501
70140  FORMAT (/49X,"ALL VISUAL ANSWERS SHOULD BE"                      05990501
     1   /49X,"ZERO FOR TEST SEGMENT TO BE"                             06000501
     2   /49X,"SUCCESSFUL" )                                            06010501
CBB** ********************** BBCSUM0  **********************************06020501
C**** WRITE OUT TEST SUMMARY                                            06030501
C****                                                                   06040501
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        06050501
      WRITE (I02, 90004)                                                06060501
      WRITE (I02, 90014)                                                06070501
      WRITE (I02, 90004)                                                06080501
      WRITE (I02, 90020) IVPASS                                         06090501
      WRITE (I02, 90022) IVFAIL                                         06100501
      WRITE (I02, 90024) IVDELE                                         06110501
      WRITE (I02, 90026) IVINSP                                         06120501
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 06130501
CBE** ********************** BBCSUM0  **********************************06140501
CBB** ********************** BBCFOOT0 **********************************06150501
C**** WRITE OUT REPORT FOOTINGS                                         06160501
C****                                                                   06170501
      WRITE (I02,90016) ZPROG, ZPROG                                    06180501
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     06190501
      WRITE (I02,90019)                                                 06200501
CBE** ********************** BBCFOOT0 **********************************06210501
CBB** ********************** BBCFMT0A **********************************06220501
C**** FORMATS FOR TEST DETAIL LINES                                     06230501
C****                                                                   06240501
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           06250501
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           06260501
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           06270501
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           06280501
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           06290501
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    06300501
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06310501
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              06320501
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06330501
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  06340501
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         06350501
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         06360501
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         06370501
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         06380501
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      06390501
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      06400501
80050 FORMAT (" ",48X,A31)                                              06410501
CBE** ********************** BBCFMT0A **********************************06420501
CBB** ********************** BBCFMAT1 **********************************06430501
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     06440501
C****                                                                   06450501
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06460501
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            06470501
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     06480501
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     06490501
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    06500501
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    06510501
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    06520501
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    06530501
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           06540501
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  06550501
     2"(",F12.5,", ",F12.5,")")                                         06560501
CBE** ********************** BBCFMAT1 **********************************06570501
CBB** ********************** BBCFMT0B **********************************06580501
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                06590501
C****                                                                   06600501
90002 FORMAT ("1")                                                      06610501
90004 FORMAT (" ")                                                      06620501
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06630501
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            06640501
90008 FORMAT (" ",21X,A13,A17)                                          06650501
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       06660501
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    06670501
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     06680501
     1       7X,"REMARKS",24X)                                          06690501
90014 FORMAT (" ","----------------------------------------------" ,    06700501
     1        "---------------------------------" )                     06710501
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               06720501
C****                                                                   06730501
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             06740501
C****                                                                   06750501
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          06760501
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        06770501
     1        A13)                                                      06780501
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 06790501
C****                                                                   06800501
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 06810501
C****                                                                   06820501
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              06830501
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              06840501
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             06850501
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  06860501
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  06870501
CBE** ********************** BBCFMT0B **********************************06880501
C*****                                                                  06890501
        RETURN                                                          06900501
        END                                                             06910501

C***********************************************************************00010502
C***** FORTRAN 77                                                       00020502
C*****   FM502                  AN502                                   00030502
C*****  THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500        00040502
C***********************************************************************00050502
C*****                                                                  00060502
C***** GENERAL PURPOSE                                                  00070502
C*****          THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS   00080502
C*****  TO BE RUN WITH SEGMENT FM500                                    00090502
C*****          THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL     00100502
C*****  AND SAVE STATEMENTS WITHIN IT.                                  00110502
C*****                                                                  00120502
        BLOCK DATA AN502                                                00130502
C*****                                                                  00140502
        IMPLICIT INTEGER (H)                                            00150502
        IMPLICIT DOUBLE PRECISION (R)                                   00160502
        IMPLICIT CHARACTER*2 (S)                                        00170502
C*****                                                                  00180502
        SAVE/BLK6/                                                      00190502
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00200502
        PARAMETER (KPI = 2, LPI = 10)                                   00210502
        INTEGER FXVI                                                    00220502
        REAL JX1S                                                       00230502
        DOUBLE PRECISION AX1D, BX4D                                     00240502
        DIMENSION BX4D(KPI, KPI, KPI, KPI)                              00250502
        COMPLEX AXVC, BX1C, CZ5C                                        00260502
        LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2)                           00270502
        CHARACTER*1 A1XVK, B1X1K, C1X7K                                 00280502
        CHARACTER*2 D2Z1K                                               00290502
        CHARACTER*4 E4XVK, G4X2K                                        00300502
        CHARACTER*(LPI) I10XVK                                          00310502
C*****                                                                  00320502
        COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2)         00330502
        COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00340502
        COMMON /BLK3/ RXVD, AX1D(2), BX4D                               00350502
        COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2)                    00360502
        COMMON /BLK5/ AXVB, BZ1B(2), CX6B                               00370502
        COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2),            00380502
     1          S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK              00390502
C*****  DECLARATION OF VARIABLES FOR EQUIVALENCE STATEMENTS             00400502
        DIMENSION AY3S(2,2,2)                                           00410502
        COMPLEX AY5C (2,2,2,2,2)                                        00420502
        LOGICAL AY1B(2)                                                 00430502
        CHARACTER*2 A2Y1K(2)                                            00440502
        CHARACTER*1 APK                                                 00450502
        PARAMETER (IPI = 5, APS = 5.3, JPI = 2, APK = 'X', MPI = 128)   00460502
C*****                                                                  00470502
        EQUIVALENCE (AY3S, DZ3S)                                        00480502
        EQUIVALENCE (NYVI, EZVS)                                        00490502
        EQUIVALENCE (AY5C, CZ5C)                                        00500502
        EQUIVALENCE (AY1B, BZ1B)                                        00510502
        EQUIVALENCE (A2Y1K, D2Z1K)                                      00520502
C*****                                                                  00530502
        DATA IXVI, FXVI, KX1I(2), HX2I(1,2), HX2I(2,2),                 00540502
     1     ((MX2I(IVI, JVI), IVI=1,2), JVI=1,2) /IPI, 6, 8, 1, 5, 4*4/  00550502
        DATA AXVS, BXVS, JX1S(1), JX1S(2), CX2S /APS, 1.23456789012345, 00560502
     1         2.45, 4.58, 4*1.2/                                       00570502
        DATA AY3S / 8*1.1/                                              00580502
        DATA NYVI /34/                                                  00590502
        DATA AX1D, BX4D(1,2,1,1), BX4D(1,2,1,2), BX4D(2,1,1,2)          00600502
     1       /JPI*1.456D3, 34.9D8, 2.123D0, 873.84D-1/                  00610502
        DATA AXVC /(1.5, 2.3)/                                          00620502
        DATA AY5C(1,1,1,2,1), AY5C(1,2,1,1,2), AY5C(2,1,1,1,2)          00630502
     1       /(1.2, 2.1), (45.3, 2.1), (309.89, 102.1)/                 00640502
        DATA BX1C(1), BX1C(2), AXVB /(1.1, 1.2), (3.2, 2.3), .TRUE./    00650502
        DATA AY1B(2), CX6B(1,1,1,2,2,1) /.FALSE., .TRUE./               00660502
        DATA A1XVK, C1X7K, S2XVK, A2Y1K(1), A2Y1K(2), E4XVK, G4X2K(1,1),00670502
     1       G4X2K(2,1), I10XVK, (B1X1K(IVI), IVI=1,2)                  00680502
     2     /'A', MPI*APK, '.,', 'TE', 'ST', 'ZXCV', 'SO', 'OS',         00690502
     3      'FINAL TEST', 2*'K'/                                        00700502
C*****                                                                  00710502
        END                                                             00720502