      PROGRAM FM104

C     COMMENT SECTION.                                                  00010104
C                                                                       00020104
C     FM104                                                             00030104
C                                                                       00040104
C         THIS ROUTINE IS A TEST OF THE / FORMAT AND IS TAPE AND PRINTER00050104
C     ORIENTED.  THE ROUTINE CAN ALSO BE USED FOR DISK.  BOTH THE READ  00060104
C     AND WRITE STATEMENTS ARE TESTED.  VARIABLES IN THE INPUT AND      00070104
C     OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR    00080104
C     ARRAY NAME REFERENCES.  ALL READ AND WRITE STATEMENTS ARE DONE    00090104
C     WITH FORMAT STATEMENTS.  THE ROUTINE HAS AN OPTIONAL SECTION OF   00100104
C     CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN.  DO LOOPS AND    00110104
C     DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL   00120104
C     INTEGER ARRAY FOR THE DUMP SECTION.                               00130104
C                                                                       00140104
C          THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS        00150104
C     REWOUND AND READ SEQUENTIALLY FORWARD.   EVERY RECORD IS READ AND 00160104
C     CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS     00170104
C     AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED.           00180104
C                                                                       00190104
C          THE LINE CONTINUATION IN COLUMN 6 IS USED IN  READ, WRITE,   00200104
C     AND FORMAT STATEMENTS.  FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL   00210104
C     STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING  00220104
C     OF THE CONTINUATION LINE.                                         00230104
C                                                                       00240104
C      REFERENCES                                                       00250104
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00260104
C              X3.9-1978                                                00270104
C                                                                       00280104
C        SECTION 8, SPECIFICATION STATEMENTS                            00290104
C        SECTION 9, DATA STATEMENT                                      00300104
C        SECTION 11.10, DO STATEMENT                                    00310104
C        SECTION 12, INPUT/OUTPUT STATEMENTS                            00320104
C        SECTION 12.8.2, INPUT/OUTPUT LIST                              00330104
C        SECTION 12.9.5.2, FORMATTED DATA TRANSFER                      00340104
C        SECTION 13, FORMAT STATEMENT                                   00350104
C        SECTION 13.2.1, EDIT DESCRIPTORS                               00360104
C        SECTION 13.5.9.1, INTEGER EDITING                              00370104
C                                                                       00380104
      COMMON ITEST(7), IACN11(57), ICHEC                                00390104
C                                                                       00400104
      DIMENSION IPREM(7), IADN11(57)                                    00410104
      DIMENSION IDUMP(136)                                              00420104
      CHARACTER*1 NINE,IZERO,IDUMP                                      00430104
      DATA NINE/'9'/, IZERO/'0'/                                        00440104
C                                                                       00450104
77701 FORMAT ( 80A1 )                                                   00460104
77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00470104
     1F ",I3," RECORDS")                                                00480104
77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS")           00490104
77704 FORMAT (10X,"FILE ON LUN " ,I2," NO EOF.. MORE THAN " ,I3, " RECOR00500104
     1DS")                                                              00510104
77705 FORMAT ( 1X,80A1)                                                 00520104
77706 FORMAT (10X,"FILE I06 CREATED WITH 28 SEQUENTIAL RECORDS" )       00530104
77751 FORMAT (I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,00540104
     157I1,I3/I3,2I2,3I3,I4,57I1,I3 )                                   00550104
77752 FORMAT (7X,I3,6X,I4,I1,56X,I3/7X,I3,67X,I3/7X,I3,67X,I3/7X,I3,67X,00560104
     1I3 )                                                              00570104
C                                                                       00580104
C                                                                       00590104
C      **********************************************************       00600104
C                                                                       00610104
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00620104
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00630104
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00640104
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00650104
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00660104
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00670104
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00680104
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00690104
C     OF EXECUTING THESE TESTS.                                         00700104
C                                                                       00710104
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00720104
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00730104
C                                                                       00740104
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00750104
C                                                                       00760104
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00770104
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00780104
C                          BUILDING 225  RM A266                        00790104
C                         GAITHERSBURG, MD  20899                       00800104
C      **********************************************************       00810104
C                                                                       00820104
C                                                                       00830104
C                                                                       00840104
C     INITIALIZATION SECTION                                            00850104
C                                                                       00860104
C     INITIALIZE CONSTANTS                                              00870104
C      **************                                                   00880104
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00890104
      I01 = 5                                                           00900104
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00910104
      I02 = 6                                                           00920104
C     SYSTEM ENVIRONMENT SECTION                                        00930104
C                                                                       00940104
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00950104
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00960104
C     (UNIT NUMBER FOR CARD READER).                                    00970104
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00980104
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00990104
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         01000104
C                                                                       01010104
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01020104
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      01030104
C     (UNIT NUMBER FOR PRINTER).                                        01040104
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01050104
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            01060104
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         01070104
C                                                                       01080104
      IVPASS=0                                                          01090104
      IVFAIL=0                                                          01100104
      IVDELE=0                                                          01110104
      ICZERO=0                                                          01120104
C                                                                       01130104
C     WRITE PAGE HEADERS                                                01140104
      WRITE (I02,90000)                                                 01150104
      WRITE (I02,90001)                                                 01160104
      WRITE (I02,90002)                                                 01170104
      WRITE (I02, 90002)                                                01180104
      WRITE (I02,90003)                                                 01190104
      WRITE (I02,90002)                                                 01200104
      WRITE (I02,90004)                                                 01210104
      WRITE (I02,90002)                                                 01220104
      WRITE (I02,90011)                                                 01230104
      WRITE (I02,90002)                                                 01240104
      WRITE (I02,90002)                                                 01250104
      WRITE (I02,90005)                                                 01260104
      WRITE (I02,90006)                                                 01270104
      WRITE (I02,90002)                                                 01280104
C                                                                       01290104
C     DEFAULT ASSIGNMENT FOR FILE 05 IS I06 = 7                         01300104
      I06 = 111                                                         01310104
CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060               01320104
CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061               01330104
C                                                                       01340104
C     WRITE SECTION....                                                 01350104
C                                                                       01360104
C     THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01370104
C     80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY   01380104
C     INTEGERS  ( I FORMAT ).  THIS IS THE ONLY FILE TESTED IN THE      01390104
C     ROUTINE FM104 AND FOR PURPOSES OF IDENTIFICATION IS FILE 05.      01400104
C     SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01410104
C     RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT.  ALL FOUR  01420104
C     OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20       01430104
C     CHARACTER PREAMBLE.  THE INTEGER STORED IN CHARACTER POSITIONS    01440104
C     78 - 80 WILL EQUAL    THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR   01450104
C     THE FOUR RECORD SET RESPECTIVELY..  THE INTEGER ARRAY ELEMENTS    01460104
C     IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9.    01470104
      IPROG = 104                                                       01480104
      IFILE = 05                                                        01490104
      ILUN = I06                                                        01500104
      ITOTR = 28                                                        01510104
      IRLGN = 80                                                        01520104
      IEOF = 0000                                                       01530104
C     SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01540104
      IPREM(1) = IPROG                                                  01550104
      IPREM(2) = IFILE                                                  01560104
      IPREM(3) = ILUN                                                   01570104
      IPREM(5) = ITOTR                                                  01580104
      IPREM(6) = IRLGN                                                  01590104
C     SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9             01600104
      DO 10 I = 1, 57                                                   01610104
      IADN11(I) = 9                                                     01620104
   10 CONTINUE                                                          01630104
      DO 872 IRNUM = 1, 7                                               01640104
      IF ( IRNUM .EQ. 7 )  IEOF = 9999                                  01650104
      IPREM(4) = IRNUM                                                  01660104
      IPREM(7) = IEOF                                                   01670104
      IVON02 = IRNUM                                                    01680104
      IVON03 = IRNUM + 1                                                01690104
      IVON04 = IRNUM + 2                                                01700104
      IVON05 = IRNUM + 3                                                01710104
      WRITE ( I06, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101720104
     11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01730104
     205                                                                01740104
  872 CONTINUE                                                          01750104
      WRITE (I02,77706)                                                 01760104
C                                                                       01770104
C     REWIND SECTION                                                    01780104
C                                                                       01790104
      REWIND I06                                                        01800104
C                                                                       01810104
C     READ SECTION....                                                  01820104
C                                                                       01830104
      IVTNUM =  87                                                      01840104
C                                                                       01850104
C     ****    TEST  87  THRU  TEST  93    ****                          01860104
C     TEST 87 THRU 93  -  THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01870104
C     CREATED AS FILE I06 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS,   01880104
C     AND THE END OF FILE INDICATOR.                                    01890104
C                                                                       01900104
      DO 932 IRNUM = 1, 7                                               01910104
      IVON01 = 0                                                        01920104
C     THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 87 - 93.01930104
      READ  ( I06, 77752 )  IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,01940104
     1IVON09,IRN04,IVON10                                               01950104
C     READ THE FILE I06  -  NOTE, FOUR RECORDS ARE READ IN EACH SINGLE  01960104
C     READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO   01970104
C     CREATE THE FILE.                                                  01980104
C                                                                       01990104
C     CHECK THE DATA ITEM VALUES  ....                                  02000104
      IF ( IRN01 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02010104
C     IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS  02020104
C     RECORD NUMBERS GO FROM 1 TO 7  ....                               02030104
      IF ( IVON06 .EQ. 9 )  IVON01 = IVON01 + 1                         02040104
C     IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL  02050104
C     TO THE INTEGER CONSTANT 9  ....                                   02060104
      IF ( IVON07 .EQ. IRNUM )  IVON01 = IVON01 + 1                     02070104
C     IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD  02080104
C     IN THE SET OF FOUR RECORDS  ....                                  02090104
      IF ( IRN02 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02100104
C     THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02110104
      IF ( IVON08 .EQ. IRNUM + 1 )  IVON01 = IVON01 + 1                 02120104
C     IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02130104
      IF ( IRN03 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02140104
C     AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS....      02150104
      IF ( IVON09 .EQ. IRNUM + 2 )  IVON01 = IVON01 + 1                 02160104
C     IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02170104
      IF ( IRN04 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02180104
C     STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS.       02190104
      IF ( IVON10 .EQ. IRNUM + 3 )  IVON01 = IVON01 + 1                 02200104
C     IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02210104
      IF ( IVON01 - 9 )  20870, 10870, 20870                            02220104
C     WHEN IVON01 = 9  THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02230104
10870 IVPASS = IVPASS + 1                                               02240104
      WRITE (I02,80001) IVTNUM                                          02250104
      GO TO  881                                                        02260104
20870 IVFAIL = IVFAIL + 1                                               02270104
      IVCOMP = IVON01                                                   02280104
      IVCORR = 9                                                        02290104
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02300104
  881 CONTINUE                                                          02310104
      IVTNUM = IVTNUM + 1                                               02320104
C     INCREMENT THE TEST NUMBER....                                     02330104
  932 CONTINUE                                                          02340104
      IF ( ICZERO )  30870, 941, 30870                                  02350104
30870 IVDELE = IVDELE + 1                                               02360104
      WRITE (I02,80003) IVTNUM                                          02370104
  941 CONTINUE                                                          02380104
      IVTNUM =  94                                                      02390104
C                                                                       02400104
C      ****  TEST  94  ****                                             02410104
C     TEST 94  -  THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02420104
C     SET OF 4 RECORDS ( 25,26,27,AND 28 ).                             02430104
C     THE VARIABLE  IEND  IS ACTUALLY IN THE RECORD NUMBERED 25.        02440104
C                                                                       02450104
      IF (ICZERO) 30940,  940, 30940                                    02460104
  940 CONTINUE                                                          02470104
      IVCOMP = IEND                                                     02480104
      GO TO 40940                                                       02490104
30940 IVDELE = IVDELE + 1                                               02500104
      WRITE (I02,80003) IVTNUM                                          02510104
      IF (ICZERO) 40940,  951, 40940                                    02520104
40940 IF ( IVCOMP - 9999 )  20940, 10940, 20940                         02530104
10940 IVPASS = IVPASS + 1                                               02540104
      WRITE (I02,80001) IVTNUM                                          02550104
      GO TO  951                                                        02560104
20940 IVFAIL = IVFAIL + 1                                               02570104
      IVCORR = 9999                                                     02580104
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02590104
  951 CONTINUE                                                          02600104
C     THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 05  02610104
C     TO THE LINE PRINTER.                                              02620104
CDB**                                                                   02630104
C     ILUN = I06                                                        02640104
C     ITOTR = 28                                                        02650104
C     IRLGN = 80                                                        02660104
C7777 REWIND ILUN                                                       02670104
C     DO 7778  IRNUM = 1, ITOTR                                         02680104
C     READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)                02690104
C     WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)               02700104
C     IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO )  GO TO 7779 02710104
C7778 CONTINUE                                                          02720104
C     GO TO 7782                                                        02730104
C7779 IF ( IRNUM - ITOTR )   7780,  7781,  7782                         02740104
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR                                02750104
C     GO TO  7784                                                       02760104
C7781 WRITE (I02,77703) ILUN,ITOTR                                      02770104
C     GO TO  7784                                                       02780104
C7782 WRITE (I02,77704) ILUN, ITOTR                                     02790104
C     DO  7783 I = 1, 5                                                 02800104
C     READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)                02810104
C     WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)               02820104
C     IF ( IDUMP(20) .EQ. NINE )  GO TO   7784                          02830104
C7783 CONTINUE                                                          02840104
C7784 GO TO 99999                                                       02850104
CDE**                                                                   02860104
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             02870104
99999 CONTINUE                                                          02880104
      WRITE (I02,90002)                                                 02890104
      WRITE (I02,90006)                                                 02900104
      WRITE (I02,90002)                                                 02910104
      WRITE (I02,90002)                                                 02920104
      WRITE (I02,90007)                                                 02930104
      WRITE (I02,90002)                                                 02940104
      WRITE (I02,90008)  IVFAIL                                         02950104
      WRITE (I02,90009) IVPASS                                          02960104
      WRITE (I02,90010) IVDELE                                          02970104
C                                                                       02980104
C                                                                       02990104
C     TERMINATE ROUTINE EXECUTION                                       03000104
      STOP                                                              03010104
C                                                                       03020104
C     FORMAT STATEMENTS FOR PAGE HEADERS                                03030104
90000 FORMAT ("1")                                                      03040104
90002 FORMAT (" ")                                                      03050104
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03060104
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   03070104
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        03080104
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03090104
90006 FORMAT (" ",5X,"----------------------------------------------" ) 03100104
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             03110104
C                                                                       03120104
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               03130104
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        03140104
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              03150104
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             03160104
C                                                                       03170104
C     FORMAT STATEMENTS FOR TEST RESULTS                                03180104
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      03190104
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      03200104
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   03210104
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         03220104
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    03230104
C                                                                       03240104
90007 FORMAT (" ",20X,"END OF PROGRAM FM104" )                          03250104
      END                                                               03260104