FM105.f Source File


Contents

Source Code


Source Code

      PROGRAM FM105

C     COMMENT SECTION.                                                  00010105
C                                                                       00020105
C     FM105                                                             00030105
C                                                                       00040105
C         FM105 TESTS REPEATED ( ) FORMAT FIELDS AND IS TAPE AND PRINTER00050105
C     ORIENTED.  THE ROUTINE CAN ALSO BE USED FOR DISK.  BOTH THE READ  00060105
C     AND WRITE STATEMENTS ARE TESTED.  VARIABLES IN THE INPUT AND      00070105
C     OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR    00080105
C     ARRAY NAME REFERENCES.  ALL READ AND WRITE STATEMENTS ARE DONE    00090105
C     WITH FORMAT STATEMENTS.  THE ROUTINE HAS AN OPTIONAL SECTION OF   00100105
C     CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN.  DO LOOPS AND    00110105
C     DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL   00120105
C     INTEGER ARRAY FOR THE DUMP SECTION.                               00130105
C                                                                       00140105
C          ROUTINE FM105 IS EXACTLY LIKE ROUTINE FM104 EXCEPT THAT      00150105
C     FORMAT NUMBERS 77751 AND 77752 HAVE BEEN CHANGED TO USE THREE (3) 00160105
C     REPEATED FIELDS, I.E.  ... 3(/ ... )     THIS SHOULD STILL        00170105
C     MAKE THE ROUTINE WRITE AND THEN READ FOUR (4) 80 CHARACTER        00180105
C     RECORDS FOR EACH SINGLE WRITE OR READ STATEMENT.  OTHER FORMAT    00190105
C     CONVERSIONS USED ARE THE X AND I FORMAT FIELDS.  BECAUSE OF THE   00200105
C     NUMBER OF CHARACTERS TO BE WRITTEN OR READ IN EACH SET OF FOUR    00210105
C     RECORDS, THE ENTIRE REPEATED FIELD IS USED.                       00220105
C                                                                       00230105
C          THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS        00240105
C     REWOUND AND READ SEQUENTIALLY FORWARD.   EVERY RECORD IS READ AND 00250105
C     CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS     00260105
C     AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED.           00270105
C                                                                       00280105
C          THE LINE CONTINUATION IN COLUMN 6 IS USED IN  READ, WRITE,   00290105
C     AND FORMAT STATEMENTS.  FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL   00300105
C     STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING  00310105
C     OF THE CONTINUATION LINE.                                         00320105
C                                                                       00330105
C      REFERENCES                                                       00340105
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00350105
C              X3.9-1978                                                00360105
C                                                                       00370105
C        SECTION 8, SPECIFICATION STATEMENTS                            00380105
C        SECTION 9, DATA STATEMENT                                      00390105
C        SECTION 11.10, DO STATEMENT                                    00400105
C        SECTION 12, INPUT/OUTPUT STATEMENTS                            00410105
C        SECTION 12.8.2, INPUT/OUTPUT LIST                              00420105
C        SECTION 12.9.5.2, FORMATTED DATA TRANSFER                      00430105
C        SECTION 13, FORMAT STATEMENT                                   00440105
C        SECTION 13.2.1, EDIT DESCRIPTORS                               00450105
C        SECTION 13.5.9.1, INTEGER EDITING                              00460105
C                                                                       00470105
C                                                                       00480105
      DIMENSION IPREM(7), IADN11(57)                                    00490105
      DIMENSION IDUMP(136)                                              00500105
      CHARACTER*1 NINE,IZERO,IDUMP                                      00510105
      DATA NINE/'9'/, IZERO/'0'/                                        00520105
C                                                                       00530105
77701 FORMAT ( 80A1 )                                                   00540105
77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00550105
     1F ",I3," RECORDS")                                                00560105
77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS")           00570105
77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00580105
     1DS")                                                              00590105
77705 FORMAT ( 1X,80A1)                                                 00600105
77706 FORMAT (10X,"FILE I08 CREATED WITH 28 SEQUENTIAL RECORDS" )       00610105
77751 FORMAT ( I3,2(I2),3(I3),I4,57(I1),I3,3(/I3,2(I2),3(I3),I4,57(I1),I00620105
     13) )                                                              00630105
77752 FORMAT ( 7(1X),I3,6(1X),I4,I1,56(1X),I3,3(/7(1X),I3,67(1X),I3) )  00640105
C                                                                       00650105
C                                                                       00660105
C      **********************************************************       00670105
C                                                                       00680105
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00690105
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00700105
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00710105
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00720105
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00730105
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00740105
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00750105
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00760105
C     OF EXECUTING THESE TESTS.                                         00770105
C                                                                       00780105
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00790105
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00800105
C                                                                       00810105
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00820105
C                                                                       00830105
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00840105
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00850105
C                          BUILDING 225  RM A266                        00860105
C                         GAITHERSBURG, MD  20899                       00870105
C      **********************************************************       00880105
C                                                                       00890105
C                                                                       00900105
C                                                                       00910105
C     INITIALIZATION SECTION                                            00920105
C                                                                       00930105
C     INITIALIZE CONSTANTS                                              00940105
C      **************                                                   00950105
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00960105
      I01 = 5                                                           00970105
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00980105
      I02 = 6                                                           00990105
C     SYSTEM ENVIRONMENT SECTION                                        01000105
C                                                                       01010105
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01020105
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      01030105
C     (UNIT NUMBER FOR CARD READER).                                    01040105
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01050105
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            01060105
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         01070105
C                                                                       01080105
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01090105
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      01100105
C     (UNIT NUMBER FOR PRINTER).                                        01110105
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01120105
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            01130105
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         01140105
C                                                                       01150105
      IVPASS=0                                                          01160105
      IVFAIL=0                                                          01170105
      IVDELE=0                                                          01180105
      ICZERO=0                                                          01190105
C                                                                       01200105
C     WRITE PAGE HEADERS                                                01210105
      WRITE (I02,90000)                                                 01220105
      WRITE (I02,90001)                                                 01230105
      WRITE (I02,90002)                                                 01240105
      WRITE (I02, 90002)                                                01250105
      WRITE (I02,90003)                                                 01260105
      WRITE (I02,90002)                                                 01270105
      WRITE (I02,90004)                                                 01280105
      WRITE (I02,90002)                                                 01290105
      WRITE (I02,90011)                                                 01300105
      WRITE (I02,90002)                                                 01310105
      WRITE (I02,90002)                                                 01320105
      WRITE (I02,90005)                                                 01330105
      WRITE (I02,90006)                                                 01340105
      WRITE (I02,90002)                                                 01350105
C                                                                       01360105
C     DEFAULT ASSIGNMENT FOR FILE 06 IS I08 = 7                         01370105
      I08 = 7                                                           01380105
CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080               01390105
CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081               01400105
C                                                                       01410105
C     WRITE SECTION....                                                 01420105
C                                                                       01430105
C     THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01440105
C     80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY   01450105
C     INTEGERS  ( I FORMAT ).  THIS IS THE ONLY FILE TESTED IN THE      01460105
C     ROUTINE FM105 AND FOR PURPOSES OF IDENTIFICATION IS FILE 06.      01470105
C     SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01480105
C     RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT.  ALL FOUR  01490105
C     OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20       01500105
C     CHARACTER PREAMBLE.  THE INTEGER STORED IN CHARACTER POSITIONS    01510105
C     78 - 80 WILL EQUAL    THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR   01520105
C     THE FOUR RECORD SET RESPECTIVELY..  THE INTEGER ARRAY ELEMENTS    01530105
C     IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9.    01540105
      IPROG = 105                                                       01550105
      IFILE = 06                                                        01560105
      ILUN = I08                                                        01570105
      ITOTR = 28                                                        01580105
      IRLGN = 80                                                        01590105
      IEOF = 0000                                                       01600105
C     SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01610105
      IPREM(1) = IPROG                                                  01620105
      IPREM(2) = IFILE                                                  01630105
      IPREM(3) = ILUN                                                   01640105
      IPREM(5) = ITOTR                                                  01650105
      IPREM(6) = IRLGN                                                  01660105
C     SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9             01670105
      DO 10 I = 1, 57                                                   01680105
      IADN11(I) = 9                                                     01690105
   10 CONTINUE                                                          01700105
      DO 952 IRNUM = 1, 7                                               01710105
      IF ( IRNUM .EQ. 7 )  IEOF = 9999                                  01720105
      IPREM(4) = IRNUM                                                  01730105
      IPREM(7) = IEOF                                                   01740105
      IVON02 = IRNUM                                                    01750105
      IVON03 = IRNUM + 1                                                01760105
      IVON04 = IRNUM + 2                                                01770105
      IVON05 = IRNUM + 3                                                01780105
      WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101790105
     11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01800105
     205                                                                01810105
  952 CONTINUE                                                          01820105
      WRITE (I02,77706)                                                 01830105
C                                                                       01840105
C     REWIND SECTION                                                    01850105
C                                                                       01860105
      REWIND I08                                                        01870105
C                                                                       01880105
C     READ SECTION....                                                  01890105
C                                                                       01900105
      IVTNUM =  95                                                      01910105
C                                                                       01920105
C     ****    TEST  95  THRU  TEST  101    ****                         01930105
C     TEST 95 THRU 101 -  THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01940105
C     CREATED AS FILE I08 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS,   01950105
C     AND THE END OF FILE INDICATOR.                                    01960105
C                                                                       01970105
      DO 962 IRNUM = 1, 7                                               01980105
      IVON01 = 0                                                        01990105
C     THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 95 - 10102000105
      READ  ( I08, 77752 )  IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,02010105
     1IVON09,IRN04,IVON10                                               02020105
C     READ THE FILE I08  -  NOTE, FOUR RECORDS ARE READ IN EACH SINGLE  02030105
C     READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO   02040105
C     CREATE THE FILE.                                                  02050105
C                                                                       02060105
C     CHECK THE DATA ITEM VALUES  ....                                  02070105
      IF ( IRN01 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02080105
C     IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS  02090105
C     RECORD NUMBERS GO FROM 1 TO 7  ....                               02100105
      IF ( IVON06 .EQ. 9 )  IVON01 = IVON01 + 1                         02110105
C     IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL  02120105
C     TO THE INTEGER CONSTANT 9  ....                                   02130105
      IF ( IVON07 .EQ. IRNUM )  IVON01 = IVON01 + 1                     02140105
C     IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD  02150105
C     IN THE SET OF FOUR RECORDS  ....                                  02160105
      IF ( IRN02 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02170105
C     THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02180105
      IF ( IVON08 .EQ. IRNUM + 1 )  IVON01 = IVON01 + 1                 02190105
C     IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02200105
      IF ( IRN03 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02210105
C     AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS....      02220105
      IF ( IVON09 .EQ. IRNUM + 2 )  IVON01 = IVON01 + 1                 02230105
C     IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02240105
      IF ( IRN04 .EQ. IRNUM )  IVON01 = IVON01 + 1                      02250105
C     STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS.       02260105
      IF ( IVON10 .EQ. IRNUM + 3 )  IVON01 = IVON01 + 1                 02270105
C     IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02280105
      IF ( IVON01 - 9 )  20960, 10960, 20960                            02290105
C     WHEN IVON01 = 9  THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02300105
10960 IVPASS = IVPASS + 1                                               02310105
      WRITE (I02,80001) IVTNUM                                          02320105
      GO TO  971                                                        02330105
20960 IVFAIL = IVFAIL + 1                                               02340105
      IVCOMP = IVON01                                                   02350105
      IVCORR = 9                                                        02360105
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02370105
  971 CONTINUE                                                          02380105
      IVTNUM = IVTNUM + 1                                               02390105
C     INCREMENT THE TEST NUMBER....                                     02400105
  962 CONTINUE                                                          02410105
      IF ( ICZERO )  30960, 1021, 30960                                 02420105
30960 IVDELE = IVDELE + 1                                               02430105
      WRITE (I02,80003) IVTNUM                                          02440105
 1021 CONTINUE                                                          02450105
      IVTNUM = 102                                                      02460105
C                                                                       02470105
C      ****  TEST 102  ****                                             02480105
C     TEST 102 -  THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02490105
C     SET OF 4 RECORDS ( 25,26,27,AND 28 ).                             02500105
C     THE VARIABLE  IEND  IS ACTUALLY IN THE RECORD NUMBERED 25.        02510105
C                                                                       02520105
      IF (ICZERO) 31020, 1020, 31020                                    02530105
 1020 CONTINUE                                                          02540105
      IVCOMP = IEND                                                     02550105
      GO TO 41020                                                       02560105
31020 IVDELE = IVDELE + 1                                               02570105
      WRITE (I02,80003) IVTNUM                                          02580105
      IF (ICZERO) 41020, 1031, 41020                                    02590105
41020 IF ( IVCOMP - 9999 )  21020, 11020, 21020                         02600105
11020 IVPASS = IVPASS + 1                                               02610105
      WRITE (I02,80001) IVTNUM                                          02620105
      GO TO 1031                                                        02630105
21020 IVFAIL = IVFAIL + 1                                               02640105
      IVCORR = 9999                                                     02650105
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02660105
 1031 CONTINUE                                                          02670105
C     THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 06  02680105
C     TO THE LINE PRINTER.                                              02690105
CDB**                                                                   02700105
C     ILUN = I08                                                        02710105
C     ITOTR = 28                                                        02720105
C     IRLGN = 80                                                        02730105
C7777 REWIND ILUN                                                       02740105
C     DO 7778  IRNUM = 1, ITOTR                                         02750105
C     READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)                02760105
C     WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)               02770105
C     IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO )  GO TO 7779 02780105
C7778 CONTINUE                                                          02790105
C     GO TO 7782                                                        02800105
C7779 IF ( IRNUM - ITOTR )   7780,  7781,  7782                         02810105
C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR                                02820105
C     GO TO  7784                                                       02830105
C7781 WRITE (I02,77703) ILUN,ITOTR                                      02840105
C     GO TO  7784                                                       02850105
C7782 WRITE (I02,77704) ILUN, ITOTR                                     02860105
C     DO  7783 I = 1, 5                                                 02870105
C     READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN)                02880105
C     WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN)               02890105
C     IF ( IDUMP(20) .EQ. NINE )  GO TO   7784                          02900105
C7783 CONTINUE                                                          02910105
C7784 GO TO 99999                                                       02920105
CDE**                                                                   02930105
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             02940105
99999 CONTINUE                                                          02950105
      WRITE (I02,90002)                                                 02960105
      WRITE (I02,90006)                                                 02970105
      WRITE (I02,90002)                                                 02980105
      WRITE (I02,90002)                                                 02990105
      WRITE (I02,90007)                                                 03000105
      WRITE (I02,90002)                                                 03010105
      WRITE (I02,90008)  IVFAIL                                         03020105
      WRITE (I02,90009) IVPASS                                          03030105
      WRITE (I02,90010) IVDELE                                          03040105
C                                                                       03050105
C                                                                       03060105
C     TERMINATE ROUTINE EXECUTION                                       03070105
      STOP                                                              03080105
C                                                                       03090105
C     FORMAT STATEMENTS FOR PAGE HEADERS                                03100105
90000 FORMAT ("1")                                                      03110105
90002 FORMAT (" ")                                                      03120105
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03130105
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   03140105
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        03150105
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03160105
90006 FORMAT (" ",5X,"----------------------------------------------" ) 03170105
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             03180105
C                                                                       03190105
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               03200105
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        03210105
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              03220105
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             03230105
C                                                                       03240105
C     FORMAT STATEMENTS FOR TEST RESULTS                                03250105
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      03260105
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      03270105
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   03280105
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         03290105
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    03300105
C                                                                       03310105
90007 FORMAT (" ",20X,"END OF PROGRAM FM105" )                          03320105
      END                                                               03330105