      PROGRAM FM013

C                                                                       00010013
C     COMMENT SECTION.                                                  00020013
C                                                                       00030013
C     FM013                                                             00040013
C                                                                       00050013
C             THIS ROUTINE TESTS THE FORTRAN  ASSIGNED GO TO STATEMENT  00060013
C     AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A  00070013
C     STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN  00080013
C     STATEMENT.  SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO        00090013
C     STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER     00100013
C     IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO.        00110013
C                                                                       00120013
C      REFERENCES                                                       00130013
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00140013
C              X3.9-1978                                                00150013
C                                                                       00160013
C        SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT    00170013
C        SECTION 11.3, ASSIGNED GO TO STATEMENT                         00180013
C                                                                       00190013
C                                                                       00200013
C      **********************************************************       00210013
C                                                                       00220013
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00230013
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00240013
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250013
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00260013
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270013
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00280013
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00290013
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300013
C     OF EXECUTING THESE TESTS.                                         00310013
C                                                                       00320013
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330013
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00340013
C                                                                       00350013
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00360013
C                                                                       00370013
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00380013
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00390013
C                          BUILDING 225  RM A266                        00400013
C                         GAITHERSBURG, MD  20899                       00410013
C      **********************************************************       00420013
C                                                                       00430013
C                                                                       00440013
C                                                                       00450013
C     INITIALIZATION SECTION                                            00460013
C                                                                       00470013
C     INITIALIZE CONSTANTS                                              00480013
C      **************                                                   00490013
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00500013
      I01 = 5                                                           00510013
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00520013
      I02 = 6                                                           00530013
C     SYSTEM ENVIRONMENT SECTION                                        00540013
C                                                                       00550013
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00560013
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00570013
C     (UNIT NUMBER FOR CARD READER).                                    00580013
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590013
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00600013
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00610013
C                                                                       00620013
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00630013
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00640013
C     (UNIT NUMBER FOR PRINTER).                                        00650013
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660013
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00670013
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00680013
C                                                                       00690013
      IVPASS=0                                                          00700013
      IVFAIL=0                                                          00710013
      IVDELE=0                                                          00720013
      ICZERO=0                                                          00730013
C                                                                       00740013
C     WRITE PAGE HEADERS                                                00750013
      WRITE (I02,90000)                                                 00760013
      WRITE (I02,90001)                                                 00770013
      WRITE (I02,90002)                                                 00780013
      WRITE (I02, 90002)                                                00790013
      WRITE (I02,90003)                                                 00800013
      WRITE (I02,90002)                                                 00810013
      WRITE (I02,90004)                                                 00820013
      WRITE (I02,90002)                                                 00830013
      WRITE (I02,90011)                                                 00840013
      WRITE (I02,90002)                                                 00850013
      WRITE (I02,90002)                                                 00860013
      WRITE (I02,90005)                                                 00870013
      WRITE (I02,90006)                                                 00880013
      WRITE (I02,90002)                                                 00890013
      IVTNUM = 126                                                      00900013
C                                                                       00910013
C     TEST 126  -  THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION00920013
C           FOR THE ASSIGNED GO TO TEST TO FOLLOW.                      00930013
C           THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT.   00940013
C                                                                       00950013
C                                                                       00960013
      IF (ICZERO) 31260, 1260, 31260                                    00970013
 1260 CONTINUE                                                          00980013
      ASSIGN 1263 TO I                                                  00990013
      GO TO I, (1262,1263,1264)                                         01000013
 1262 ICON01 = 1262                                                     01010013
      GO TO 1265                                                        01020013
 1263 ICON01 = 1263                                                     01030013
      GO TO 1265                                                        01040013
 1264 ICON01 = 1264                                                     01050013
 1265 CONTINUE                                                          01060013
      GO TO 41260                                                       01070013
31260 IVDELE = IVDELE + 1                                               01080013
      WRITE (I02,80003) IVTNUM                                          01090013
      IF (ICZERO) 41260, 1271, 41260                                    01100013
41260 IF ( ICON01 - 1263 )  21260, 11260, 21260                         01110013
11260 IVPASS = IVPASS + 1                                               01120013
      WRITE (I02,80001) IVTNUM                                          01130013
      GO TO 1271                                                        01140013
21260 IVFAIL = IVFAIL + 1                                               01150013
      IVCOMP=ICON01                                                     01160013
      IVCORR = 1263                                                     01170013
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01180013
 1271 CONTINUE                                                          01190013
      IVTNUM = 127                                                      01200013
C                                                                       01210013
C     TEST 127  -  THIS IS A TEST OF MORE COMPLEX BRANCHING USING       01220013
C           THE ASSIGN AND ASSIGNED GO TO STATEMENTS.  THIS TEST IS NOT 01230013
C           INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING.        01240013
C                                                                       01250013
C                                                                       01260013
      IF (ICZERO) 31270, 1270, 31270                                    01270013
 1270 CONTINUE                                                          01280013
      IVON01=0                                                          01290013
 1272 ASSIGN 1273 TO J                                                  01300013
      IVON01=IVON01+1                                                   01310013
      GO TO 1276                                                        01320013
 1273 ASSIGN 1274 TO J                                                  01330013
      IVON01=IVON01 * 10 + 2                                            01340013
      GO TO 1276                                                        01350013
 1274 ASSIGN 1275 TO J                                                  01360013
      IVON01=IVON01 * 100 + 3                                           01370013
      GO TO 1276                                                        01380013
 1275 GO TO 1277                                                        01390013
 1276 GO TO J, ( 1272, 1273, 1274, 1275 )                               01400013
 1277 CONTINUE                                                          01410013
      GO TO 41270                                                       01420013
31270 IVDELE = IVDELE + 1                                               01430013
      WRITE (I02,80003) IVTNUM                                          01440013
      IF (ICZERO) 41270, 1281, 41270                                    01450013
41270 IF ( IVON01 - 1203 )  21270, 11270, 21270                         01460013
11270 IVPASS = IVPASS + 1                                               01470013
      WRITE (I02,80001) IVTNUM                                          01480013
      GO TO 1281                                                        01490013
21270 IVFAIL = IVFAIL + 1                                               01500013
      IVCOMP=IVON01                                                     01510013
      IVCORR=1203                                                       01520013
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01530013
 1281 CONTINUE                                                          01540013
      IVTNUM = 128                                                      01550013
C                                                                       01560013
C     TEST 128  -  TEST OF THE ASSIGNED GO TO WITH ALL OF THE           01570013
C           STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME       01580013
C           VALUE EXCEPT FOR ONE.                                       01590013
C                                                                       01600013
C                                                                       01610013
      IF (ICZERO) 31280, 1280, 31280                                    01620013
 1280 CONTINUE                                                          01630013
      ICON01=0                                                          01640013
      ASSIGN 1283 TO K                                                  01650013
      GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 )             01660013
 1282 ICON01 = 0                                                        01670013
      GO TO 1284                                                        01680013
 1283 ICON01 = 1                                                        01690013
 1284 CONTINUE                                                          01700013
      GO TO 41280                                                       01710013
31280 IVDELE = IVDELE + 1                                               01720013
      WRITE (I02,80003) IVTNUM                                          01730013
      IF (ICZERO) 41280, 1291, 41280                                    01740013
41280 IF ( ICON01 - 1 )  21280, 11280, 21280                            01750013
11280 IVPASS = IVPASS + 1                                               01760013
      WRITE (I02,80001) IVTNUM                                          01770013
      GO TO 1291                                                        01780013
21280 IVFAIL = IVFAIL + 1                                               01790013
      IVCOMP=ICON01                                                     01800013
      IVCORR=1                                                          01810013
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01820013
 1291 CONTINUE                                                          01830013
      IVTNUM = 129                                                      01840013
C                                                                       01850013
C     TEST 129  -  THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION       01860013
C           WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT.  THE VALUE     01870013
C           OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY 01880013
C           THE COMBINATION OF STATEMENTS.                              01890013
C                                                                       01900013
C                                                                       01910013
      IF (ICZERO) 31290, 1290, 31290                                    01920013
 1290 CONTINUE                                                          01930013
      ICON01=0                                                          01940013
      ASSIGN 1292 TO L                                                  01950013
      L = 1293                                                          01960013
      ASSIGN 1294 TO L                                                  01970013
      GO TO L, ( 1294, 1293, 1292 )                                     01980013
 1292 ICON01 = 0                                                        01990013
      GO TO 1295                                                        02000013
 1293 ICON01 = 0                                                        02010013
      GO TO 1295                                                        02020013
 1294 ICON01 = 1                                                        02030013
 1295 CONTINUE                                                          02040013
      GO TO 41290                                                       02050013
31290 IVDELE = IVDELE + 1                                               02060013
      WRITE (I02,80003) IVTNUM                                          02070013
      IF (ICZERO) 41290, 1301, 41290                                    02080013
41290 IF ( ICON01 - 1 )  21290, 11290, 21290                            02090013
11290 IVPASS = IVPASS + 1                                               02100013
      WRITE (I02,80001) IVTNUM                                          02110013
      GO TO 1301                                                        02120013
21290 IVFAIL = IVFAIL + 1                                               02130013
      IVCOMP=ICON01                                                     02140013
      IVCORR=1                                                          02150013
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02160013
 1301 CONTINUE                                                          02170013
      IVTNUM = 130                                                      02180013
C                                                                       02190013
C     TEST 130  -  THIS IS A TEST OF A LOOP USING A COMBINATION OF THE  02200013
C           ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT.   02210013
C           THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL  02220013
C           SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01.           02230013
C                                                                       02240013
C                                                                       02250013
      IF (ICZERO) 31300, 1300, 31300                                    02260013
 1300 CONTINUE                                                          02270013
      IVON01=0                                                          02280013
 1302 ASSIGN 1302 TO M                                                  02290013
      IVON01=IVON01+1                                                   02300013
      IF ( IVON01 - 10 )  1303, 1303, 1304                              02310013
 1303 GO TO 1305                                                        02320013
 1304 ASSIGN 1306 TO M                                                  02330013
 1305 GO TO M, ( 1302, 1306 )                                           02340013
 1306 CONTINUE                                                          02350013
      GO TO 41300                                                       02360013
31300 IVDELE = IVDELE + 1                                               02370013
      WRITE (I02,80003) IVTNUM                                          02380013
      IF (ICZERO) 41300, 1311, 41300                                    02390013
41300 IF ( IVON01 - 11 )  21300, 11300, 21300                           02400013
11300 IVPASS = IVPASS + 1                                               02410013
      WRITE (I02,80001) IVTNUM                                          02420013
      GO TO 1311                                                        02430013
21300 IVFAIL = IVFAIL + 1                                               02440013
      IVCOMP=IVON01                                                     02450013
      IVCORR=11                                                         02460013
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02470013
 1311 CONTINUE                                                          02480013
C                                                                       02490013
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             02500013
99999 CONTINUE                                                          02510013
      WRITE (I02,90002)                                                 02520013
      WRITE (I02,90006)                                                 02530013
      WRITE (I02,90002)                                                 02540013
      WRITE (I02,90002)                                                 02550013
      WRITE (I02,90007)                                                 02560013
      WRITE (I02,90002)                                                 02570013
      WRITE (I02,90008)  IVFAIL                                         02580013
      WRITE (I02,90009) IVPASS                                          02590013
      WRITE (I02,90010) IVDELE                                          02600013
C                                                                       02610013
C                                                                       02620013
C     TERMINATE ROUTINE EXECUTION                                       02630013
      STOP                                                              02640013
C                                                                       02650013
C     FORMAT STATEMENTS FOR PAGE HEADERS                                02660013
90000 FORMAT ("1")                                                      02670013
90002 FORMAT (" ")                                                      02680013
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02690013
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   02700013
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        02710013
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02720013
90006 FORMAT (" ",5X,"----------------------------------------------" ) 02730013
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             02740013
C                                                                       02750013
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02760013
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        02770013
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              02780013
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             02790013
C                                                                       02800013
C     FORMAT STATEMENTS FOR TEST RESULTS                                02810013
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      02820013
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      02830013
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   02840013
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         02850013
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    02860013
C                                                                       02870013
90007 FORMAT (" ",20X,"END OF PROGRAM FM013" )                          02880013
      END                                                               02890013