FM903.f Source File

**********00010904 * FORTRAN 77 00020904 FM904 SN904 - (790) 00030904 * THIS SUBROUTINE IS CALLED BY FM903 00040904 **********00050904 GENERAL PURPOSE ANS REFS 00060904 * THIS SUBROUTINE IS CALLED BY IOFMTF (354) 00070904 IT IS USED PRIMARILY TO TEST THAT A CHARACTER 13.1.2 00080904 * CONSTANT MAY BE PASSED AS A PARAMETER TO A 15.6.2.3 00090904 SUBROUTINE AND USED AS A FORMAT. 00100904 * IT ALSO TESTS THAT A FORMAT MAY BE DEFINED IN A 9.4 00110904 DATA STATEMENT. 00120904 * RESTRICTIONS OBSERVED 00130904 SEE SEGMENT 354 00140904 **** 00150904



Contents

Source Code


Source Code

      PROGRAM FM903

C***********************************************************************00010903
C*****  FORTRAN 77                                                      00020903
C*****   FM903               IOFMTF - (354)                             00030903
C*****   THIS PROGRAM CALLS SUBROUTINE SN904                            00040903
C***********************************************************************00050903
C*****  GENERAL PURPOSE                                        ANS REFS 00060903
C*****    TO TEST ADDITIONAL FEATURES OF READ AND WRITE        12.8     00070903
C*****    STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS  12.1.1   00080903
C*****    DOUBLE PRECISION AND COMPLEX DATA TYPES.                      00090903
C*****    TO TEST ALL FORMS OF CHARACTER EXPRESSIONS AS        13.1.2   00100903
C*****    FORMAT SPECIFIERS.                                            00110903
C*****  RESTRICTIONS OBSERVED                                           00120903
C*****  *  H AND X DESCRIPTORS ARE NEVER REPEATED              13.2.1   00130903
C*****  *  FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND               00140903
C*****     W IS EQUAL TO OR GREATER THAN D                              00150903
C*****  *  FIELD WIDTH IS NEVER ZERO                                    00160903
C*****  *  IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM          13.3     00170903
C*****     AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST           00180903
C*****     IN THE FORMAT SPECIFICATION                                  00190903
C*****  *  ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS             00200903
C*****  *  NEGATIVE OUTPUT VALUES ARE SIGNED                   13.5.9   00210903
C*****  *  AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT         13.5.2   00220903
C*****  *  IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR      13.5.9.1 00230903
C*****     THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED            00240903
C*****     INTEGER CONSTANT                                             00250903
C*****  GENERAL COMMENTS                                                00260903
C*****     PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED     13.5.9   00270903
C*****                                                                  00280903
C*****     CALL SUBROUTINE SN904 (SEGMENT 790)                          00290903
C*****                                                                  00300903
CBB** ********************** BBCCOMNT **********************************00310903
C****                                                                   00320903
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00330903
C****                          VERSION 2.1                              00340903
C****                                                                   00350903
C****                                                                   00360903
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00370903
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00380903
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00390903
C****                      BUILDING 225  RM A266                        00400903
C****                     GAITHERSBURG, MD  20899                       00410903
C****                                                                   00420903
C****                                                                   00430903
C****                                                                   00440903
CBE** ********************** BBCCOMNT **********************************00450903
C*****                                                                  00460903
C  INPUT DATA TO THIS SEGMENT CONSISTS OF 14 CARD IMAGES IN COL. 1 - 56 00470903
COL.      1-----------------------------------------------------56      00480903
CARD  1   333144446666225555                                            00490903
CARD  2   1234567890                                                    00500903
CARD  3   1234567890                                                    00510903
CARD  4   1234567890                                                    00520903
CARD  5   1234567890                                                    00530903
CARD  6    12345                                                        00540903
CARD  7    12345123.5123.45D-01 12345D+01                               00550903
CARD  8   12 345 678                                                    00560903
CARD  9       5-1111 3333-5555 7777-9999                                00570903
CARD 10   12345678901234567890123456781234567890123456789012345678      00580903
CARD 11   12345678901234123456789012341234567890123412345678901234      00590903
CARD 12   12345678901234123456789012341234567890123456789012345678      00600903
CARD 13   12345678901234567890123456781234567890123456789012345678      00610903
CARD 14   12345678901234123456789012341234567890123412345678901234      00620903
C*****                                                                  00630903
C*****  S P E C I F I C A T I O N S  SEGMENT 354                        00640903
C*****                                                                  00650903
        INTEGER J1I(6)                                                  00660903
        INTEGER IA1I(8)                                                 00670903
        CHARACTER*11 A11VK                                              00680903
        CHARACTER*15 C151K(7)                                           00690903
        CHARACTER*19 A19VK                                              00700903
        CHARACTER*25 C251K(6)                                           00710903
        CHARACTER*32 A32VK                                              00720903
        CHARACTER*52 A52VK                                              00730903
        CHARACTER*65 A65VK                                              00740903
        CHARACTER*85 A85VK                                              00750903
        DOUBLE PRECISION AVD, A1D(4), B4D(2,1,2,2)                      00760903
        COMPLEX AVC, BVC, CVC, A2C(2,2)                                 00770903
        EXTERNAL SN904                                                  00780903
C*****                                                                  00790903
CBB** ********************** BBCINITA **********************************00800903
C**** SPECIFICATION STATEMENTS                                          00810903
C****                                                                   00820903
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00830903
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00840903
CBE** ********************** BBCINITA **********************************00850903
CBB** ********************** BBCINITB **********************************00860903
C**** INITIALIZE SECTION                                                00870903
      DATA  ZVERS,                  ZVERSD,             ZDATE           00880903
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00890903
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00900903
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00910903
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00920903
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00930903
      DATA   REMRKS /'                               '/                 00940903
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00950903
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00960903
C****                                                                   00970903
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00980903
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00990903
CZ03  ZPROG  = 'PROGRAM NAME'                                           01000903
CZ04  ZDATE  = 'DATE OF TEST'                                           01010903
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                01020903
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          01030903
CZ07  ZNAME  = 'NAME OF USER'                                           01040903
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          01050903
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       01060903
C                                                                       01070903
      IVPASS = 0                                                        01080903
      IVFAIL = 0                                                        01090903
      IVDELE = 0                                                        01100903
      IVINSP = 0                                                        01110903
      IVTOTL = 0                                                        01120903
      IVTOTN = 0                                                        01130903
      ICZERO = 0                                                        01140903
C                                                                       01150903
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         01160903
      I01 = 05                                                          01170903
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             01180903
      I02 = 06                                                          01190903
C                                                                       01200903
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01210903
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      01220903
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     01230903
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  01240903
C                                                                       01250903
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     01260903
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       01270903
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     01280903
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  01290903
C                                                                       01300903
CBE** ********************** BBCINITB **********************************01310903
      IRVI = I01                                                        01320903
      NUVI = I02                                                        01330903
      IVTOTL = 13                                                       01340903
      ZPROG = 'FM903'                                                   01350903
CBB** ********************** BBCHED0A **********************************01360903
C****                                                                   01370903
C**** WRITE REPORT TITLE                                                01380903
C****                                                                   01390903
      WRITE (I02, 90002)                                                01400903
      WRITE (I02, 90006)                                                01410903
      WRITE (I02, 90007)                                                01420903
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 01430903
      WRITE (I02, 90009)  ZPROG, ZPROG                                  01440903
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 01450903
CBE** ********************** BBCHED0A **********************************01460903
C*****    HEADER FORMAT STATEMENT                                       01470903
        WRITE(NUVI, 35400)                                              01480903
35400   FORMAT(" ",/ 1X, "IOFMTF - (354) ADDITIONAL FORMATTED" //1X,    01490903
     1         "DATA TRANSFERS" ,//1X,                                  01500903
     2         "ANS REF. - 12.9.5.2  13.1  13.5" )                      01510903
CBB** ********************** BBCHED0B **********************************01520903
C**** WRITE DETAIL REPORT HEADERS                                       01530903
C****                                                                   01540903
      WRITE (I02,90004)                                                 01550903
      WRITE (I02,90004)                                                 01560903
      WRITE (I02,90013)                                                 01570903
      WRITE (I02,90014)                                                 01580903
      WRITE (I02,90015) IVTOTL                                          01590903
CBE** ********************** BBCHED0B **********************************01600903
C*****    TEST THAT A FORMAT MAY BE A CHARACTER VARIABLE,     12.4.2(3) 01610903
C*****    A CHARACTER EXPRESSION, A CHARACTER ARRAY, OR A     12.4.2(4) 01620903
C*****    CHARACTER ARRAY ELEMENT.                            13.1.2    01630903
C*****    NOTE THAT  THE LENGTH OF THE FORMAT MAY EXCEED THE            01640903
C*****    LENGTH OF AN ARRAY ELEMENT IF THE FORMAT SPECIFIER            01650903
C*****    IS AN ARRAY, BUT NOT IF THE SPECIFIER IS AN ARRAY ELEMENT.    01660903
        WRITE(NUVI, 35401)                                              01670903
35401   FORMAT(/8X, "CHARACTER EXPRESSION AS FORMAT" /)                 01680903
        A19VK = '(I3,I1,I4,I4,I2,I4)'                                   01690903
C*****    CARD 1                                                        01700903
        READ(IRVI, A19VK) J1I(3), J1I(1), J1I(4), J1I(6), J1I(2), J1I(5)01710903
CT001*  TEST 1 - CHARACTER EXPRESSION AS FORMAT                         01720903
           IVTNUM = 1                                                   01730903
           REMRKS = 'LEADING PLUS SIGN OPTIONAL'                        01740903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           01750903
        A65VK = '16X, "COMPUTED: "/26X,I1, 1X, I2, 1X, I3, 1X, I4, 1X,  01760903
     1I5, 1X, I6'                                                       01770903
        A85VK = '16X, "CORRECT:  ",22X, "2 CORRECT ANSWERS POSSIBLE"/26X01780903
     1, "1 22 333 4444  5555   6666"'                                   01790903
        WRITE(NUVI, '(/1X,' // A65VK // '/1X,' // A85VK // ')') J1I     01800903
           IVINSP = IVINSP + 1                                          01810903
           WRITE (NUVI, 70010)                                          01820903
70010      FORMAT (26X,"1 22 333 4444 +5555  +6666" )                   01830903
CT002*  TEST 2 - CHARACTER ARRAY AS FORMAT                              01840903
           IVTNUM = 2                                                   01850903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           01860903
           WRITE (NUVI, 80020)                                          01870903
        C251K(1) = '(26X, I6, 1X, I5, 1X, I4,'                          01880903
        C251K(2) = ' 1X, I3, 1X, I2, 1X, I1 /'                          01890903
        C251K(3) = '17X,"CORRECT: ",22X, "2 C'                          01900903
        C251K(4) = 'ORRECT ANSWERS POSSIBLE"/'                          01910903
        C251K(5) = '26X,  "  6666  5555 4444 '                          01920903
        C251K(6) = '333 22 1")'                                         01930903
        WRITE(NUVI, C251K) (J1I(7-IVI), IVI=1,6)                        01940903
           IVINSP = IVINSP + 1                                          01950903
           WRITE (NUVI, 70020)                                          01960903
70020      FORMAT (26X," +6666 +5555 4444 333 22 1" )                   01970903
CT003*  TEST 3 - CHARACTER ARRAY ELEMENT AS FORMAT                      01980903
           IVTNUM = 3                                                   01990903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           02000903
           WRITE (NUVI, 80020)                                          02010903
C*****                                                                  02020903
        C151K(1) = '(I1,2X,I2)'                                         02030903
        C151K(3) = '(2X,I3,1X,I4)'                                      02040903
        C151K(5) = '(I5,T1,I1)'                                         02050903
        C151K(7) = '(TR4,I2,TL2,I3)'                                    02060903
C*****    CARDS 2-5                                                     02070903
        DO 0032 IVI = 1, 7, 2                                           02080903
        READ(IRVI, C151K(IVI)) IA1I(IVI), IA1I(IVI+1)                   02090903
 0032   CONTINUE                                                        02100903
        WRITE(NUVI, 70030) IA1I                                         02110903
70030   FORMAT (25X, 8(1X, I5))                                         02120903
           IVINSP = IVINSP + 1                                          02130903
           WRITE (NUVI, 70031)                                          02140903
70031   FORMAT (" ",16X,"CORRECT:  " ,22X,"2 CORRECT ANSWERS POSSIBLE" )02150903
           WRITE (NUVI, 70032)                                          02160903
70032   FORMAT(26X, '    1    45   345  7890 12345     1    56   567'/  02170903
     1         26X, '   +1   +45  +345 +7890 12345    +1   +56  +567')  02180903
C*****                                                                  02190903
C*****    TEST ADDITIONAL INTEGER EDITING FEATURES.                     02200903
C*****      - IW.M EDITING DESCRIPTOR                          13.5.9.1 02210903
C*****    NOTE THAT IF M IS ZERO AND THE VALUE OF THE INTERNAL          02220903
C*****    DATUM IS ZERO, THE OUTPUT FIELD CONSISTS OF ONLY BLANK        02230903
C*****    CHARACTERS REGARDLESS OF THE SIGN CONTROL IN EFFECT.          02240903
        WRITE(NUVI, 35404)                                              02250903
35404   FORMAT(/8X, "INTEGER EDITING AND OUT OF RANGE" /)               02260903
C*****    CARD 6                                                        02270903
        READ(IRVI, 35405) (IA1I(IVI), IVI=1,4)                          02280903
35405   FORMAT(I6.6, T1, I6.4, TL6, I6.2, TL9, I6.0)                    02290903
CT004*  TEST 4 - INTEGER EDITING                                        02300903
           IVTNUM = 4                                                   02310903
           WRITE (NUVI, 80004) IVTNUM,REMRKS                            02320903
           WRITE (NUVI, 80020)                                          02330903
        WRITE(NUVI, 70040) (IA1I(IVI), IVI=1,4)                         02340903
70040   FORMAT(25X, 4(1X, I6))                                          02350903
           IVINSP = IVINSP + 1                                          02360903
           WRITE (NUVI, 70031)                                          02370903
           WRITE (NUVI, 70041)                                          02380903
70041   FORMAT(26X, " 12345  12345  12345  12345" /                     02390903
     1         26X, "+12345 +12345 +12345 +12345" )                     02400903
CT005*  TEST 5 - OUT OF RANGE                                           02410903
           IVTNUM = 5                                                   02420903
           WRITE (NUVI, 80004) IVTNUM                                   02430903
           WRITE (NUVI, 80020)                                          02440903
        JVI = 0                                                         02450903
        IVI = 12                                                        02460903
        WRITE (NUVI, 70050) -IVI, IVI, IVI, IVI, IVI, JVI, JVI, JVI     02470903
70050   FORMAT (26X, SS, I5.5, S, 1X, I5.5, SS, 1X, I5.3, 1X, I5.1,     02480903
     1          1X, I5.0, 1X, "(", I5.0, ")", S, 1X, "(", I5.0, ")",    02490903
     2          SP, 1X, "(", I5.0, ")")                                 02500903
           IVINSP = IVINSP + 1                                          02510903
           WRITE (NUVI, 80022)                                          02520903
           WRITE (NUVI, 70051)                                          02530903
70051   FORMAT (26X, "***** 00012   012    12    12 (     ) (     )" ,  02540903
     1          " (     )")                                             02550903
C  ADVANCE TO TOP-OF PAGE AND WRITE HEADERS                             02560903
        WRITE (NUVI, 90002)                                             02570903
        WRITE (NUVI, 90013)                                             02580903
        WRITE (NUVI, 90014)                                             02590903
C*****                                                                  02600903
C*****    TEST ADDITIONAL DOUBLE PRECISION EDITING FEATURES. 13.5.9.2   02610903
C*****      - D.P. MAY BE READ, WRITTEN WITH F AND E         13.5.9.2.1 02620903
C*****        EDIT DESCRIPTOR.                               13.5.9.2.2 02630903
C*****        (D AND G FORMATS ARE TEST IN INTERNAL FILE SEGMENTS       02640903
C*****        392 AND 393.)                                             02650903
C*****      - FIELD WIDTH TOO SMALL ON F                     13.5.9(4)  02660903
C*****      - EXPONENT WIDTH TOO SMALL ON EW.DE(E)           13.5.9(4)  02670903
C*****      - IF SP AND FIELD TOO SMALL, THE PLUS IS NOT     13.5.9(5)  02680903
C*****        OPTIONAL                                                  02690903
        WRITE(NUVI, 35408)                                              02700903
35408   FORMAT(/8X,"DOUBLE PRECISION EDITING AND OUT OF RANGE" /)       02710903
C*****    CARD 7                                                        02720903
        READ(IRVI, 35409) B4D                                           02730903
35409   FORMAT(1X, 2F5.2, F10.2, F10.5, TL40, 1X, 2E5.2, E10.2, E10.5E5)02740903
CT006*  TEST 6 - DOUBLE PRECISION EDITING AND OUT OF RANGE              02750903
           IVTNUM = 6                                                   02760903
           REMRKS = '2 COMPUTED LINES EXPECTED'                         02770903
           WRITE (NUVI, 80004) IVTNUM,REMRKS                            02780903
           WRITE (NUVI, 80020)                                          02790903
        B4D(2,1,2,2) = (B4D(2,1,2,2) * 10) ** 12                        02800903
        WRITE(NUVI, 70060) B4D                                          02810903
70060  FORMAT(26X, SP, F6.2, SS, 1X, F5.4, 1X, F6.3, 1X, F6.4,          02820903
     1     /26X,2P,E6.1,0P,2(5X,E10.5),5X,E9.5E1)                       02830903
           IVINSP = IVINSP + 1                                          02840903
           WRITE (NUVI, 70061)                                          02850903
70061      FORMAT(/" ",16X,"CORRECT:  " ,22X,  "CORRESPONDING LINES MUST02860903
     1 MATCH "    ,/" ",48X,"EITHER OF THE FOLLOWING TWO    "  ,        02870903
     2            /" ",48X,"CORRECT ANSWERS                "  )         02880903
           WRITE (NUVI, 70062)                                          02890903
70062      FORMAT(26X,"****** ***** 12.345 1.2345" /26X,                02900903
     1            "******     .12350E+03     .12345E+02     *********" /02910903
     2           /26X,"****** ***** 12.345 1.2345" /26X,                02920903
     3            "******     .12350+003     .12345+002     *********" )02930903
C*****                                                                  02940903
C*****    TEST ADDITIONAL COMPLEX EDITING FEATURES.          13.5.9.2.4 02950903
C*****      - FIELD WIDTH TOO SMALL ON F                     13.5.9(4)  02960903
C*****      - EXPONENT WIDTH TOO SMALL ON EW.DE(E)           13.5.9(4)  02970903
        WRITE(NUVI, 35411)                                              02980903
35411   FORMAT(/8X, "COMPLEX EDITING AND OUT OF RANGE" /)               02990903
CT007*  TEST 7 - COMPLEX EDITING AND OUT OF RANGE                       03000903
           IVTNUM = 7                                                   03010903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           03020903
           WRITE (NUVI, 80020)                                          03030903
        AVC = (25.25, 75.75)                                            03040903
        BVC = (0.25E+10, 0.75E+10)                                      03050903
        WRITE(NUVI, 70070) AVC, AVC, BVC, BVC                           03060903
70070   FORMAT (26X, F7.2, 3X, F6.2, 3X, F5.2, 3X, F4.2,                03070903
     1          /26X, E8.2E3, 3X, E7.2E2, 2(4X, E6.2E1))                03080903
           IVINSP = IVINSP + 1                                          03090903
           WRITE (NUVI, 70061)                                          03100903
           WRITE (NUVI, 70071)                                          03110903
70071      FORMAT (26X, "  25.25    75.75   25.25   ****" /             03120903
     1             25X, " .25E+010   .75E+10    ******    ******" //    03130903
     2             26X, " +25.25   +75.75   25.25   ****" /             03140903
     3             25X, " .25E+010   .75E+10    ******    ******" )     03150903
C*****                                                                  03160903
C*****    -  TEST BZ, BN EDIT DESCRIPTORS                      13.5.8   03170903
C*****    -  TEST T, TL, TR EDIT DESCRIPTORS                   13.5.3.1 03180903
        WRITE(NUVI, 35414)                                              03190903
35414   FORMAT(/8X,"BZ, BN, T, TL AND TR EDIT DESCRIPTOR" /)            03200903
CT008*  TEST 8 - BZ, BN, T, TL, AND TR EDIT DESCRIPTOR                  03210903
           IVTNUM = 8                                                   03220903
           REMRKS = 'LEADING PLUS SIGN OPTIONAL'                        03230903
           WRITE (NUVI, 80004) IVTNUM,REMRKS                            03240903
           WRITE (NUVI, 80020)                                          03250903
C*****    CARD 8                                                        03260903
        READ(IRVI, 70080) AVD, B4D(2,1,1,2), A2C(1,1), AVC              03270903
70080   FORMAT(BN, D5.2, BZ, D5.2, TL40, 2F5.2, T1, TR1, TL1, BN, 2F5.1)03280903
        WRITE(NUVI, 70081) AVD, B4D(2,1,1,2), A2C(1,1), AVC             03290903
70081   FORMAT (25X, 2F6.2, (((4(1X, F6.2)))))                          03300903
           IVINSP = IVINSP + 1                                          03310903
           WRITE (NUVI, 70031)                                          03320903
           WRITE (NUVI, 70082)                                          03330903
70082      FORMAT(25X, TR26, " 123.40 567.80" , T25, "  12.34506.78" ,  03340903
     1            1X, "120.34 506.78" //                                03350903
     2            25X, TR26, " 123.40 567.80" , T25, " +12.34506.78" ,  03360903
     3            1X, "120.34 506.78" )                                 03370903
C*****                                                                  03380903
C*****    PASS A CHARACTER CONSTANT, WHICH IS A LEGITIMATE FORMAT       03390903
C*****    SPECIFIER TO A SUBROUTINE.                                    03400903
        WRITE(NUVI, 35417)                                              03410903
35417   FORMAT(/8X,"SUBROUTINE CALL" /)                                 03420903
CT009*  TEST 9 - SUBROUTINE CALL                                        03430903
           IVTNUM = 9                                                   03440903
           WRITE (NUVI, 80004) IVTNUM,REMRKS                            03450903
C*****    CARD 9                                                        03460903
        A11VK = '(I5, 6(I5))'                                           03470903
        CALL SN904(A11VK, IRVI, NUVI)                                   03480903
           IVINSP = IVINSP + 1                                          03490903
C*****                                                                  03500903
C  ADVANCE TO TOP-OF PAGE AND WRITE HEADERS                             03510903
        WRITE (NUVI, 90002)                                             03520903
        WRITE (NUVI, 90013)                                             03530903
        WRITE (NUVI, 90014)                                             03540903
C*****                                                                  03550903
C*****    -  TEST SS AND SP EDIT DESCRIPTORS.                    13.5.6 03560903
C*****    -  TEST ALSO THAT A FORMAT SPECIFICATION MAY BE        13.1.2 03570903
C*****       ALTERED BY A CHARACTER SUBSTRING SUBSTITUTION.       5.7   03580903
        WRITE(NUVI, 35419)                                              03590903
35419   FORMAT(/8X,"SS AND SP EDIT DESCRIPTOR" /)                       03600903
CT010*  TEST 10 - SS AND SP EDIT DESCRIPTORS                            03610903
           IVTNUM = 10                                                  03620903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           03630903
           WRITE (NUVI, 80020)                                          03640903
        IVI = 12345                                                     03650903
        AVS = 25.25                                                     03660903
        A1D(2) = 5.5D0                                                  03670903
        A2C(2,1) = (3.0, 4.0)                                           03680903
        A52VK = '(26X,SP,F5.1,SS,2X,F4.1,SP,(T40,I6,2X,F6.2,SS,F6.1))'  03690903
        WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03700903
           IVINSP = IVINSP + 1                                          03710903
           WRITE (NUVI, 70101)                                          03720903
70101      FORMAT(/" ",16X,"CORRECT:  " ,22X,  "CORRESPONDING LINES MUST03730903
     1 MATCH "    )                                                     03740903
           WRITE (NUVI, 70102)                                          03750903
70102      FORMAT(26X,' +3.0   4.0  +12345  +25.25   5.5'               03760903
     1            /T40,' 12345   25.25   5.5')                          03770903
CT011*  TEST 11 - FORMAT ALTERED BY CHARACTER SUBSTRING SUBSTITUTION    03780903
           IVTNUM = 11                                                  03790903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           03800903
           WRITE (NUVI, 80020)                                          03810903
        A52VK(7:7) = 'S'                                                03820903
        A52VK(14:15) = 'SP'                                             03830903
        A52VK(26:26) = 'S'                                              03840903
        A52VK(45:45) = 'P'                                              03850903
        WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03860903
           IVINSP = IVINSP + 1                                          03870903
           WRITE (NUVI, 70101)                                          03880903
           WRITE (NUVI, 70111)                                          03890903
70111      FORMAT (26X,'  3.0  +4.0   12345   25.25  +5.5'              03900903
     1             /T40,'+12345  +25.25  +5.5')                         03910903
C*****                                                                  03920903
C*****    TEST A COLON EDIT DESCRIPTOR FOLLOWED BY A H-EDIT      13.5.5 03930903
C*****    DESCRIPTOR TO SHOW THAT THE COLON EDIT DESCRIPTOR             03940903
C*****    TERMINATED IF THERE ARE NO MORE ITEMS IN THE INPUT/OUTPUT LIST03950903
        WRITE(NUVI, 35422)                                              03960903
35422   FORMAT(/8X,'COLON EDIT DESCRIPTOR'/)                            03970903
CT012*  TEST 12                                                         03980903
           IVTNUM = 12                                                  03990903
           REMRKS = '2 COMPUTED LINES EXPECTED'                         04000903
           WRITE (NUVI, 80004) IVTNUM, REMRKS                           04010903
           WRITE (NUVI, 80020)                                          04020903
        A32VK = 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH'                      04030903
        WRITE(NUVI, 70120) A32VK, A32VK                                 04040903
70120   FORMAT(26X, A32, :, 'IIIIJJJJ')                                 04050903
           IVINSP = IVINSP + 1                                          04060903
           WRITE (NUVI, 70101)                                          04070903
           WRITE (NUVI, 70121)                                          04080903
70121      FORMAT(26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ',      04090903
     1            /26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH')             04100903
C*****                                                                  04110903
C*****    TEST THAT FW.D, EW.DE(E) AND GW.DE(E) MAY HAVE MORE DIGITS ON 04120903
C*****    INPUT THAN THE PROCESSOR CAN HANDLE FOR D.P. AND COMPLEX      04130903
CT013*  TEST 13 - LARGE FORMAT SIZE FOR D.P. AND COMPLEX                04140903
           IVTNUM = 13                                                  04150903
           WRITE (NUVI, 70131) IVTNUM                                   04160903
70131      FORMAT (/" ",2X,I3,4X,"INSPECT",32X,                         04170903
     1             'TEST SUCCESSFUL IF PROCESSOR IS '/" ",48X,          04180903
     2             'ABLE TO READ INPUT CARDS 10-14  '/" ",48X,          04190903
     3             'UNDER F, E, AND G FORMATS WHICH '/" ",48X,          04200903
     4             'HAVE  MORE  DIGITS  THAN  THE   '/" ",48X,          04210903
     5             'PROCESSOR CAN HANDLE FOR D. P.  '/" ",48X,          04220903
     6             'AND COMPLEX')                                       04230903
           IVINSP = IVINSP + 1                                          04240903
C*****    CARDS 10-14                                                   04250903
        READ(IRVI, 70130) B4D(1,1,1,1), AVD, AVC, A2C(2,2), BVC,        04260903
     1       (B4D(1,1,IVI,1),IVI=1,2), A1D(1), A2C(1,2), CVC            04270903
70130   FORMAT(2F28.14, /2(E14.7E2, G14.14E1), /G14.0E3, E14.14E3,      04280903
     1         E28.0E1, /2G28.14E2, /2(F14.0, F14.14) )                 04290903
C*****                                                                  04300903
CBB** ********************** BBCSUM0  **********************************04310903
C**** WRITE OUT TEST SUMMARY                                            04320903
C****                                                                   04330903
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        04340903
      WRITE (I02, 90004)                                                04350903
      WRITE (I02, 90014)                                                04360903
      WRITE (I02, 90004)                                                04370903
      WRITE (I02, 90020) IVPASS                                         04380903
      WRITE (I02, 90022) IVFAIL                                         04390903
      WRITE (I02, 90024) IVDELE                                         04400903
      WRITE (I02, 90026) IVINSP                                         04410903
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 04420903
CBE** ********************** BBCSUM0  **********************************04430903
CBB** ********************** BBCFOOT0 **********************************04440903
C**** WRITE OUT REPORT FOOTINGS                                         04450903
C****                                                                   04460903
      WRITE (I02,90016) ZPROG, ZPROG                                    04470903
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     04480903
      WRITE (I02,90019)                                                 04490903
CBE** ********************** BBCFOOT0 **********************************04500903
CBB** ********************** BBCFMT0A **********************************04510903
C**** FORMATS FOR TEST DETAIL LINES                                     04520903
C****                                                                   04530903
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           04540903
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           04550903
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           04560903
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           04570903
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           04580903
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    04590903
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04600903
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              04610903
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04620903
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  04630903
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         04640903
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         04650903
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         04660903
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         04670903
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      04680903
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      04690903
80050 FORMAT (" ",48X,A31)                                              04700903
CBE** ********************** BBCFMT0A **********************************04710903
CBB** ********************** BBCFMAT1 **********************************04720903
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     04730903
C****                                                                   04740903
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04750903
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            04760903
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     04770903
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     04780903
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    04790903
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    04800903
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    04810903
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    04820903
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           04830903
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  04840903
     2"(",F12.5,", ",F12.5,")")                                         04850903
CBE** ********************** BBCFMAT1 **********************************04860903
CBB** ********************** BBCFMT0B **********************************04870903
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                04880903
C****                                                                   04890903
90002 FORMAT ("1")                                                      04900903
90004 FORMAT (" ")                                                      04910903
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04920903
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            04930903
90008 FORMAT (" ",21X,A13,A17)                                          04940903
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       04950903
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    04960903
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     04970903
     1       7X,"REMARKS",24X)                                          04980903
90014 FORMAT (" ","----------------------------------------------" ,    04990903
     1        "---------------------------------" )                     05000903
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               05010903
C****                                                                   05020903
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             05030903
C****                                                                   05040903
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          05050903
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        05060903
     1        A13)                                                      05070903
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 05080903
C****                                                                   05090903
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 05100903
C****                                                                   05110903
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              05120903
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              05130903
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             05140903
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  05150903
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  05160903
CBE** ********************** BBCFMT0B **********************************05170903
C*****                                                                  05180903
C*****    END OF TEST SEGMENT 354                                       05190903
        STOP                                                            05200903
        END                                                             05210903

C***********************************************************************00010904
C*****  FORTRAN 77                                                      00020904
C*****   FM904               SN904 - (790)                              00030904
C*****   THIS SUBROUTINE IS CALLED BY FM903                             00040904
C***********************************************************************00050904
C*****  GENERAL PURPOSE                                       ANS REFS  00060904
C*****    THIS SUBROUTINE IS CALLED BY IOFMTF (354)                     00070904
C*****    IT IS USED PRIMARILY TO TEST THAT A CHARACTER       13.1.2    00080904
C*****    CONSTANT MAY BE PASSED AS A PARAMETER TO A          15.6.2.3  00090904
C*****    SUBROUTINE AND USED AS A FORMAT.                              00100904
C*****    IT ALSO TESTS THAT A FORMAT MAY BE DEFINED IN A      9.4      00110904
C*****    DATA STATEMENT.                                               00120904
C*****  RESTRICTIONS OBSERVED                                           00130904
C*****    SEE SEGMENT 354                                               00140904
C*****                                                                  00150904
        SUBROUTINE SN904(A0WVK, IRWVI, NUWVI)                           00160904
C*****                                                                  00170904
C*****  S P E C I F I C A T I O N S   SEGMENT 790                       00180904
C*****                                                                  00190904
        CHARACTER*(*) A0WVK                                             00200904
        CHARACTER*130 A130VK                                            00210904
        INTEGER I1I(5)                                                  00220904
C*****                                                                  00230904
C*****    TESTS THAT                                                    00240904
C*****    - A FORMAT SPECIFIER MAY BE PASSED AS A CHARACTER      13.1.2 00250904
C*****      CONSTANT TO A SUBROUTINE.                          15.6.2.3 00260904
C*****    - A FORMAT SPECIFIER MAY BE DEFINED IN A DATA          13.1.2 00270904
C*****      STATEMENT.                                              9.4 00280904
C*****    - AN INPUT LIST MAY CONTAIN AN INTEGER THAT IS USED  12.8.2.3 00290904
C*****      AS A SUBSCRIPT IN AN IMPLIED DO-LIST.                       00300904
C*****    - AN OUTPUT LIST MAY CONTAIN AN EXPRESSION WITH AN   12.8.2.2 00310904
C*****      INTRINISC FUNCTION.                                15.3     00320904
C*****                                                                  00330904
        DATA A130VK/'(16X, "COMPUTED: "/26X, 3I5/16X, "CORRECT:  ",22X, 00340904
     1''2 CORRECT ANSWERS POSSIBLE''/26X,'' 1111 3333-5555''/26X,''+111100350904
     2+3333-5555'')'/                                                   00360904
        READ(IRWVI, A0WVK) IVI, (I1I(JVI),JVI=1,IVI)                    00370904
        WRITE(NUWVI, A130VK) IABS(I1I(1)), MAX0(I1I(2),I1I(5)), I1I(3)  00380904
C*****                                                                  00390904
        RETURN                                                          00400904
        END                                                             00410904