      PROGRAM FM503

C***********************************************************************00010503
C*****  FORTRAN 77                                                      00020503
C*****   FM503                                                          00030503
C*****                       BLKD2 - (261)                              00040503
C*****   THIS PROGRAM USES FM504 (UNNAMED BLOCK DATA SUBPROGRAM         00050503
C*****   AND SUBROUTINE SN505                                           00060503
C***********************************************************************00070503
C*****  TESTING OF BLOCK DATA SUBPROGRAMS                       ANS REF 00080503
C*****          DATA INTERNAL FORMS                               16    00090503
C*****  THIS SEGMENT USES SEGMENTS 702 AND 703, BLOCK DATA PROGRAM      00100503
C*****  FM504 AND SUBROUTINE SN505                                      00110503
C*****                                                                  00120503
CBB** ********************** BBCCOMNT **********************************00130503
C****                                                                   00140503
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00150503
C****                          VERSION 2.1                              00160503
C****                                                                   00170503
C****                                                                   00180503
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00190503
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00200503
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00210503
C****                      BUILDING 225  RM A266                        00220503
C****                     GAITHERSBURG, MD  20899                       00230503
C****                                                                   00240503
C****                                                                   00250503
C****                                                                   00260503
CBE** ********************** BBCCOMNT **********************************00270503
C*****                                                                  00280503
C*****  S P E C I F I C A T I O N S  SEGMENT 261                        00290503
C*****                                                                  00300503
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00310503
C*****  DOUBLE PRECISION AXVD, DVCORR                                   00320503
C*****  COMPLEX AXVC, ZVCORR                                            00330503
C*****  LOGICAL AXVB                                                    00340503
C*****  CHARACTER*6 A6XVK, B6XVK, CVCORR                                00350503
C*****                                                                  00360503
C*****  COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB                00370503
C*****  COMMON /BLK7/ A6XVK, B6XVK                                      00380503
C*****                                                                  00390503
C*****                                                                  00400503
        CALL SN505                                                      00410503
        STOP                                                            00420503
C*****                                                                  00430503
C*****          END OF TEST SEGMENT 261                                 00440503
        END                                                             00450503

C***********************************************************************00010504
C***** FORTRAN 77                                                       00020504
C*****   FM504                  BDS2 (UNNAMED) - (702)                  00030504
C*****   THIS BLOCK DATA SUBPROGRAM IS USED BY FM503                    00040504
C***********************************************************************00050504
C*****                                                                  00060504
C***** GENERAL PURPOSE                                                  00070504
C*****          THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS   00080504
C*****  TO BE RUN WITH TEST SEGMENT 261                                 00090504
C*****          THIS SEGMENT WILL TEST INTERNAL DATA FORMS, AS WELL     00100504
C*****  AS THE USE OF UNNAMED BLOCK DATA PROGRAM                        00110504
C*****                                                                  00120504
        BLOCK DATA                                                      00130504
C*****                                                                  00140504
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00150504
        DOUBLE PRECISION AXVD                                           00160504
        COMPLEX AXVC                                                    00170504
        LOGICAL AXVB                                                    00180504
        CHARACTER*6 A6XVK, B6XVK                                        00190504
C*****                                                                  00200504
        COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB                00210504
        COMMON /BLK7/ A6XVK, B6XVK                                      00220504
        DATA AXVS, BXVS, IXVI, AXVD, AXVC, AXVB /34.25E-1, 43.23, 21,   00230504
     1       1.23456, (234.23, 34.9), .TRUE./                           00240504
        DATA A6XVK, B6XVK /'ABCDE', 'FGHIJK'/                           00250504
C*****                                                                  00260504
        END                                                             00270504

C***********************************************************************00010505
C***** FORTRAN 77                                                       00020505
C*****   FM505                  BLKD2Q - (703)                          00030505
C*****   THIS SUBROUTINE IS CALLED BY FM503                             00040505
C***********************************************************************00050505
C*****                                                                  00060505
C***** GENERAL PURPOSE                                                  00070505
C*****  THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 261                 00080505
C*****     THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF     00090505
C*****  IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY        00100505
C*****  VARIABLES                                                       00110505
C*****                                                                  00120505
        SUBROUTINE SN505                                                00130505
C*****                                                                  00140505
C*****                                                                  00150505
C*****  DECLARATION OF VARIABLES IN COMMON BLOCKS                       00160505
        DOUBLE PRECISION AXVD, DVCORR                                   00170505
        COMPLEX AXVC, ZVCORR                                            00180505
        LOGICAL AXVB                                                    00190505
        CHARACTER*6 A6XVK, B6XVK, CVCORR                                00200505
C*****                                                                  00210505
        COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB                00220505
        COMMON /BLK7/ A6XVK, B6XVK                                      00230505
C*****  LOCAL DECLARATION                                               00240505
        DOUBLE PRECISION AVD                                            00250505
        COMPLEX AVC                                                     00260505
        REAL R2E(2)                                                     00270505
        EQUIVALENCE (AVC, R2E)                                          00280505
C*****                                                                  00290505
CBB** ********************** BBCINITA **********************************00300505
C**** SPECIFICATION STATEMENTS                                          00310505
C****                                                                   00320505
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00330505
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00340505
CBE** ********************** BBCINITA **********************************00350505
CBB** ********************** BBCINITB **********************************00360505
C**** INITIALIZE SECTION                                                00370505
      DATA  ZVERS,                  ZVERSD,             ZDATE           00380505
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00390505
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00400505
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00410505
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00420505
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00430505
      DATA   REMRKS /'                               '/                 00440505
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00450505
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00460505
C****                                                                   00470505
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00480505
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00490505
CZ03  ZPROG  = 'PROGRAM NAME'                                           00500505
CZ04  ZDATE  = 'DATE OF TEST'                                           00510505
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00520505
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00530505
CZ07  ZNAME  = 'NAME OF USER'                                           00540505
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00550505
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00560505
C                                                                       00570505
      IVPASS = 0                                                        00580505
      IVFAIL = 0                                                        00590505
      IVDELE = 0                                                        00600505
      IVINSP = 0                                                        00610505
      IVTOTL = 0                                                        00620505
      IVTOTN = 0                                                        00630505
      ICZERO = 0                                                        00640505
C                                                                       00650505
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00660505
      I01 = 05                                                          00670505
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00680505
      I02 = 06                                                          00690505
C                                                                       00700505
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710505
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00720505
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00730505
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00740505
C                                                                       00750505
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00760505
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00770505
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00780505
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00790505
C                                                                       00800505
CBE** ********************** BBCINITB **********************************00810505
      NUVI = I02                                                        00820505
      IVTOTL = 8                                                        00830505
      ZPROG = 'FM503'                                                   00840505
CBB** ********************** BBCHED0A **********************************00850505
C****                                                                   00860505
C**** WRITE REPORT TITLE                                                00870505
C****                                                                   00880505
      WRITE (I02, 90002)                                                00890505
      WRITE (I02, 90006)                                                00900505
      WRITE (I02, 90007)                                                00910505
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00920505
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00930505
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00940505
CBE** ********************** BBCHED0A **********************************00950505
        WRITE(NUVI,26100)                                               00960505
26100   FORMAT( " ", /  " BLKD2 - (261) BLOCK DATA SUBPROGRAM --" //    00970505
     1          "  DATA INTERNAL FORMS" //                              00980505
     2          "  ANS REF. - 16" )                                     00990505
CBB** ********************** BBCHED0B **********************************01000505
C**** WRITE DETAIL REPORT HEADERS                                       01010505
C****                                                                   01020505
      WRITE (I02,90004)                                                 01030505
      WRITE (I02,90004)                                                 01040505
      WRITE (I02,90013)                                                 01050505
      WRITE (I02,90014)                                                 01060505
      WRITE (I02,90015) IVTOTL                                          01070505
CBE** ********************** BBCHED0B **********************************01080505
C*****                                                                  01090505
CT001*  TEST 1                            REAL VARIABLE - EXPONENT FORM 01100505
           IVTNUM = 1                                                   01110505
        AVS = AXVS                                                      01120505
           IF (AVS - 0.34248E+01) 20010, 10010, 40010                   01130505
40010      IF (AVS - 0.34252E+01) 10010, 10010, 20010                   01140505
10010      IVPASS = IVPASS + 1                                          01150505
           WRITE (NUVI, 80002) IVTNUM                                   01160505
           GO TO 0011                                                   01170505
20010      IVFAIL = IVFAIL + 1                                          01180505
           RVCORR = 34.25E-1                                            01190505
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01200505
 0011      CONTINUE                                                     01210505
CT002*  TEST 2                        REAL VARIABLE - NON EXPONENT FORM 01220505
           IVTNUM = 2                                                   01230505
        AVS = BXVS                                                      01240505
           IF (AVS - 0.43227E+02) 20020, 10020, 40020                   01250505
40020      IF (AVS - 0.43233E+02) 10020, 10020, 20020                   01260505
10020      IVPASS = IVPASS + 1                                          01270505
           WRITE (NUVI, 80002) IVTNUM                                   01280505
           GO TO 0021                                                   01290505
20020      IVFAIL = IVFAIL + 1                                          01300505
           RVCORR = 43.23                                               01310505
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01320505
 0021      CONTINUE                                                     01330505
CT003*  TEST 3                                         INTEGER VARIABLE 01340505
           IVTNUM = 3                                                   01350505
        IVI = IXVI                                                      01360505
           IF (IVI -    21) 20030, 10030, 20030                         01370505
10030      IVPASS = IVPASS + 1                                          01380505
           WRITE (NUVI, 80002) IVTNUM                                   01390505
           GO TO 0031                                                   01400505
20030      IVFAIL = IVFAIL + 1                                          01410505
           IVCORR =    21                                               01420505
           WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR                      01430505
 0031      CONTINUE                                                     01440505
CT004*  TEST 4                                DOUBLE PRECISION VARIABLE 01450505
           IVTNUM = 4                                                   01460505
        AVD = AXVD                                                      01470505
           IF (AVD - 0.12345D+01) 20040, 10040, 40040                   01480505
40040      IF (AVD - 0.12347D+01) 10040, 10040, 20040                   01490505
10040      IVPASS = IVPASS + 1                                          01500505
           WRITE (NUVI, 80002) IVTNUM                                   01510505
           GO TO 0041                                                   01520505
20040      IVFAIL = IVFAIL + 1                                          01530505
           DVCORR = 1.23456D+0                                          01540505
           WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR                      01550505
 0041      CONTINUE                                                     01560505
CT005*  TEST 5                                         COMPLEX VARIABLE 01570505
           IVTNUM = 5                                                   01580505
        AVC = AXVC                                                      01590505
           IF (R2E(1) - 0.23421E+03) 20050, 40052, 40051                01600505
40051      IF (R2E(1) - 0.23425E+03) 40052, 40052, 20050                01610505
40052      IF (R2E(2) - 0.34898E+02) 20050, 10050, 40050                01620505
40050      IF (R2E(2) - 0.34902E+02) 10050, 10050, 20050                01630505
10050      IVPASS = IVPASS + 1                                          01640505
           WRITE (NUVI, 80002) IVTNUM                                   01650505
           GO TO 0051                                                   01660505
20050      IVFAIL = IVFAIL + 1                                          01670505
           ZVCORR = (234.23, 34.9)                                      01680505
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      01690505
 0051      CONTINUE                                                     01700505
CT006*  TEST 6                                         LOGICAL VARIABLE 01710505
           IVTNUM = 6                                                   01720505
           IVI = 0                                                      01730505
           IF (AXVB) IVI = 1                                            01740505
           IF (IVI - 1) 20060, 10060, 20060                             01750505
10060      IVPASS = IVPASS + 1                                          01760505
           WRITE (NUVI, 80002) IVTNUM                                   01770505
           GO TO 0061                                                   01780505
20060      IVFAIL = IVFAIL + 1                                          01790505
           LVCORR = 1                                                   01800505
           REMRKS = '1 = TRUE ;  0 = FALSE'                             01810505
           WRITE (NUVI, 80008) IVTNUM, REMRKS                           01820505
           WRITE (NUVI, 80024) IVI                                      01830505
           WRITE (NUVI, 80026) LVCORR                                   01840505
 0061      CONTINUE                                                     01850505
CT007*  TEST 7            6 CHARACTER VARIABLE - INIT WITH 5 CHARACTERS 01860505
           IVTNUM = 7                                                   01870505
           IVI = 0                                                      01880505
           IF (A6XVK.EQ.'ABCDE ') IVI = 1                               01890505
           IF (IVI - 1) 20070, 10070, 20070                             01900505
10070      IVPASS = IVPASS + 1                                          01910505
           WRITE (NUVI, 80002) IVTNUM                                   01920505
           GO TO 0071                                                   01930505
20070      IVFAIL = IVFAIL + 1                                          01940505
           CVCORR = 'ABCDE '                                            01950505
           WRITE (NUVI, 80018) IVTNUM, A6XVK, CVCORR                    01960505
 0071      CONTINUE                                                     01970505
CT008*  TEST 8            6 CHARACTER VARIABLE - INIT WITH 6 CHARACTERS 01980505
           IVTNUM = 8                                                   01990505
           IVI = 0                                                      02000505
           IF (B6XVK.EQ.'FGHIJK') IVI = 1                               02010505
           IF (IVI - 1) 20080, 10080, 20080                             02020505
10080      IVPASS = IVPASS + 1                                          02030505
           WRITE (NUVI, 80002) IVTNUM                                   02040505
           GO TO 0081                                                   02050505
20080      IVFAIL = IVFAIL + 1                                          02060505
           CVCORR = 'FGHIJK'                                            02070505
           WRITE (NUVI, 80018) IVTNUM, B6XVK, CVCORR                    02080505
 0081      CONTINUE                                                     02090505
C*****                                                                  02100505
CBB** ********************** BBCSUM0  **********************************02110505
C**** WRITE OUT TEST SUMMARY                                            02120505
C****                                                                   02130505
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02140505
      WRITE (I02, 90004)                                                02150505
      WRITE (I02, 90014)                                                02160505
      WRITE (I02, 90004)                                                02170505
      WRITE (I02, 90020) IVPASS                                         02180505
      WRITE (I02, 90022) IVFAIL                                         02190505
      WRITE (I02, 90024) IVDELE                                         02200505
      WRITE (I02, 90026) IVINSP                                         02210505
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02220505
CBE** ********************** BBCSUM0  **********************************02230505
CBB** ********************** BBCFOOT0 **********************************02240505
C**** WRITE OUT REPORT FOOTINGS                                         02250505
C****                                                                   02260505
      WRITE (I02,90016) ZPROG, ZPROG                                    02270505
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02280505
      WRITE (I02,90019)                                                 02290505
CBE** ********************** BBCFOOT0 **********************************02300505
CBB** ********************** BBCFMT0A **********************************02310505
C**** FORMATS FOR TEST DETAIL LINES                                     02320505
C****                                                                   02330505
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02340505
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02350505
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02360505
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02370505
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02380505
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02390505
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02400505
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02410505
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02420505
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02430505
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02440505
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02450505
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02460505
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02470505
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02480505
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02490505
80050 FORMAT (" ",48X,A31)                                              02500505
CBE** ********************** BBCFMT0A **********************************02510505
CBB** ********************** BBCFMAT1 **********************************02520505
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02530505
C****                                                                   02540505
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02550505
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02560505
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02570505
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02580505
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    02590505
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    02600505
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    02610505
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    02620505
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02630505
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  02640505
     2"(",F12.5,", ",F12.5,")")                                         02650505
CBE** ********************** BBCFMAT1 **********************************02660505
CBB** ********************** BBCFMT0B **********************************02670505
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02680505
C****                                                                   02690505
90002 FORMAT ("1")                                                      02700505
90004 FORMAT (" ")                                                      02710505
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02720505
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02730505
90008 FORMAT (" ",21X,A13,A17)                                          02740505
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02750505
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02760505
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02770505
     1       7X,"REMARKS",24X)                                          02780505
90014 FORMAT (" ","----------------------------------------------" ,    02790505
     1        "---------------------------------" )                     02800505
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               02810505
C****                                                                   02820505
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02830505
C****                                                                   02840505
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          02850505
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        02860505
     1        A13)                                                      02870505
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 02880505
C****                                                                   02890505
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 02900505
C****                                                                   02910505
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              02920505
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              02930505
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             02940505
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  02950505
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  02960505
CBE** ********************** BBCFMT0B **********************************02970505
C*****                                                                  02980505
        END                                                             02990505