| 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 |