PROGRAM FM022 C COMMENT SECTION. 00010022 C 00020022 C FM022 00030022 C 00040022 C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00050022 C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00060022 C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00070022 C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00080022 C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00090022 C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00100022 C USE OF THE EQUIVALENCE STATEMENT. 00110022 C 00120022 C REFERENCES 00130022 C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140022 C X3.9-1978 00150022 C 00160022 C SECTION 8, SPECIFICATION STATEMENTS 00170022 C SECTION 8.1, DIMENSION STATEMENT 00180022 C SECTION 8.2, EQUIVALENCE STATEMENT 00190022 C SECTION 8.3, COMMON STATEMENT 00200022 C SECTION 8.4, TYPE-STATEMENTS 00210022 C SECTION 9, DATA STATEMENT 00220022 C 00230022 C 00240022 C 00250022 COMMON IADN14(5), RADN14(5), LADN13(2) 00260022 C 00270022 DIMENSION IADN11(5), RADN11(5), LADN11(2) 00280022 DIMENSION IADN12(5), RADN12(5), LADN12(2) 00290022 DIMENSION IADN15(2), RADN15(2) 00300022 DIMENSION IADN16(4), IADN17(4) 00310022 C 00320022 INTEGER RADN13(5) 00330022 REAL IADN13(5) 00340022 LOGICAL LADN11, LADN12, LADN13, LCTN01 00350022 C 00360022 EQUIVALENCE (IADN14(1), IADN15(1)), (RADN14(2),RADN15(2)) 00370022 EQUIVALENCE (LADN13(1),LCTN01), (IADN14(5), ICON02) 00380022 EQUIVALENCE (RADN14(5), RCON01) 00390022 EQUIVALENCE ( IADN16(3), IADN17(2) ) 00400022 C 00410022 DATA IADN12(1)/3/, RADN12(1)/-512./, IADN13(1)/0.5/, RADN13(1)/-3/00420022 C 00430022 C 00440022 C 00450022 C ********************************************************** 00460022 C 00470022 C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00480022 C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00490022 C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00500022 C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00510022 C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00520022 C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00530022 C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00540022 C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00550022 C OF EXECUTING THESE TESTS. 00560022 C 00570022 C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00580022 C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00590022 C 00600022 C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00610022 C 00620022 C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00630022 C SOFTWARE STANDARDS VALIDATION GROUP 00640022 C BUILDING 225 RM A266 00650022 C GAITHERSBURG, MD 20899 00660022 C ********************************************************** 00670022 C 00680022 C 00690022 C 00700022 C INITIALIZATION SECTION 00710022 C 00720022 C INITIALIZE CONSTANTS 00730022 C ************** 00740022 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750022 I01 = 5 00760022 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770022 I02 = 6 00780022 C SYSTEM ENVIRONMENT SECTION 00790022 C 00800022 CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00810022 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820022 C (UNIT NUMBER FOR CARD READER). 00830022 CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00840022 C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850022 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860022 C 00870022 CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00880022 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890022 C (UNIT NUMBER FOR PRINTER). 00900022 CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00910022 C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920022 C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930022 C 00940022 IVPASS=0 00950022 IVFAIL=0 00960022 IVDELE=0 00970022 ICZERO=0 00980022 C 00990022 C WRITE PAGE HEADERS 01000022 WRITE (I02,90000) 01010022 WRITE (I02,90001) 01020022 WRITE (I02,90002) 01030022 WRITE (I02, 90002) 01040022 WRITE (I02,90003) 01050022 WRITE (I02,90002) 01060022 WRITE (I02,90004) 01070022 WRITE (I02,90002) 01080022 WRITE (I02,90011) 01090022 WRITE (I02,90002) 01100022 WRITE (I02,90002) 01110022 WRITE (I02,90005) 01120022 WRITE (I02,90006) 01130022 WRITE (I02,90002) 01140022 IVTNUM = 604 01150022 C 01160022 C **** TEST 604 **** 01170022 C TEST 604 - THIS TESTS A SIMPLE ASSIGNMENT STATEMENT IN SETTING 01180022 C AN INTEGER ARRAY ELEMENT TO A POSITIVE VALUE OF 32767. 01190022 C 01200022 IF (ICZERO) 36040, 6040, 36040 01210022 6040 CONTINUE 01220022 IADN11(5) = 32767 01230022 IVCOMP = IADN11(5) 01240022 GO TO 46040 01250022 36040 IVDELE = IVDELE + 1 01260022 WRITE (I02,80003) IVTNUM 01270022 IF (ICZERO) 46040, 6051, 46040 01280022 46040 IF ( IVCOMP - 32767 ) 26040, 16040, 26040 01290022 16040 IVPASS = IVPASS + 1 01300022 WRITE (I02,80001) IVTNUM 01310022 GO TO 6051 01320022 26040 IVFAIL = IVFAIL + 1 01330022 IVCORR = 32767 01340022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350022 6051 CONTINUE 01360022 IVTNUM = 605 01370022 C 01380022 C **** TEST 605 **** 01390022 C TEST 605 - TEST OF A SIMPLE ASSIGN WITH A NEGATIVE VALUE -32766 01400022 C 01410022 IF (ICZERO) 36050, 6050, 36050 01420022 6050 CONTINUE 01430022 IADN11(1) = -32766 01440022 IVCOMP = IADN11(1) 01450022 GO TO 46050 01460022 36050 IVDELE = IVDELE + 1 01470022 WRITE (I02,80003) IVTNUM 01480022 IF (ICZERO) 46050, 6061, 46050 01490022 46050 IF ( IVCOMP + 32766 ) 26050, 16050, 26050 01500022 16050 IVPASS = IVPASS + 1 01510022 WRITE (I02,80001) IVTNUM 01520022 GO TO 6061 01530022 26050 IVFAIL = IVFAIL + 1 01540022 IVCORR = -32766 01550022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560022 6061 CONTINUE 01570022 IVTNUM = 606 01580022 C 01590022 C **** TEST 606 **** 01600022 C TEST 606 - TEST OF UNSIGNED ZERO SET TO AN ARRAY ELEMENT 01610022 C BY A SIMPLE ASSIGNMENT STATEMENT. 01620022 C 01630022 IF (ICZERO) 36060, 6060, 36060 01640022 6060 CONTINUE 01650022 IADN11(3) = 0 01660022 IVCOMP = IADN11(3) 01670022 GO TO 46060 01680022 36060 IVDELE = IVDELE + 1 01690022 WRITE (I02,80003) IVTNUM 01700022 IF (ICZERO) 46060, 6071, 46060 01710022 46060 IF ( IVCOMP - 0 ) 26060, 16060, 26060 01720022 16060 IVPASS = IVPASS + 1 01730022 WRITE (I02,80001) IVTNUM 01740022 GO TO 6071 01750022 26060 IVFAIL = IVFAIL + 1 01760022 IVCORR = 0 01770022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780022 6071 CONTINUE 01790022 IVTNUM = 607 01800022 C 01810022 C **** TEST 607 **** 01820022 C TEST 607 - TEST OF A NEGATIVELY SIGNED ZERO COMPARED TO A 01830022 C ZERO UNSIGNED BOTH VALUES SET AS INTEGER ARRAY ELEMENTS. 01840022 C 01850022 IF (ICZERO) 36070, 6070, 36070 01860022 6070 CONTINUE 01870022 IADN11(2) = -0 01880022 IADN11(3) = 0 01890022 ICON01 = 0 01900022 IF ( IADN11(2) .EQ. IADN11(3) ) ICON01 = 1 01910022 GO TO 46070 01920022 36070 IVDELE = IVDELE + 1 01930022 WRITE (I02,80003) IVTNUM 01940022 IF (ICZERO) 46070, 6081, 46070 01950022 46070 IF ( ICON01 - 1 ) 26070, 16070, 26070 01960022 16070 IVPASS = IVPASS + 1 01970022 WRITE (I02,80001) IVTNUM 01980022 GO TO 6081 01990022 26070 IVFAIL = IVFAIL + 1 02000022 IVCOMP = ICON01 02010022 IVCORR = 1 02020022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02030022 6081 CONTINUE 02040022 IVTNUM = 608 02050022 C 02060022 C **** TEST 608 **** 02070022 C TEST 608 - TEST OF SETTING ONE INTEGER ARRAY ELEMENT EQUAL TO 02080022 C THE VALUE OF ANOTHER INTEGER ARRAY ELEMENT. THE VALUE IS 32767. 02090022 C 02100022 IF (ICZERO) 36080, 6080, 36080 02110022 6080 CONTINUE 02120022 IADN11(1) = 32767 02130022 IADN12(5) = IADN11(1) 02140022 IVCOMP = IADN12(5) 02150022 GO TO 46080 02160022 36080 IVDELE = IVDELE + 1 02170022 WRITE (I02,80003) IVTNUM 02180022 IF (ICZERO) 46080, 6091, 46080 02190022 46080 IF ( IVCOMP - 32767 ) 26080, 16080, 26080 02200022 16080 IVPASS = IVPASS + 1 02210022 WRITE (I02,80001) IVTNUM 02220022 GO TO 6091 02230022 26080 IVFAIL = IVFAIL + 1 02240022 IVCORR = 32767 02250022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02260022 6091 CONTINUE 02270022 IVTNUM = 609 02280022 C 02290022 C **** TEST 609 **** 02300022 C TEST 609 - TEST OF AN ARRAY ELEMENT SET TO ANOTHER ARRAY ELEMENT02310022 C WHICH HAD BEEN SET AT COMPILE TIME BY A DATA INITIALIZATION 02320022 C STATEMENT. AN INTEGER ARRAY IS USED WITH THE VALUE 3. 02330022 C 02340022 IF (ICZERO) 36090, 6090, 36090 02350022 6090 CONTINUE 02360022 IADN11(4) = IADN12(1) 02370022 IVCOMP = IADN11(4) 02380022 GO TO 46090 02390022 36090 IVDELE = IVDELE + 1 02400022 WRITE (I02,80003) IVTNUM 02410022 IF (ICZERO) 46090, 6101, 46090 02420022 46090 IF ( IVCOMP - 3 ) 26090, 16090, 26090 02430022 16090 IVPASS = IVPASS + 1 02440022 WRITE (I02,80001) IVTNUM 02450022 GO TO 6101 02460022 26090 IVFAIL = IVFAIL + 1 02470022 IVCORR = 3 02480022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02490022 6101 CONTINUE 02500022 IVTNUM = 610 02510022 C 02520022 C **** TEST 610 **** 02530022 C TEST 610 - TEST OF SETTING A REAL ARRAY ELEMENT TO A POSITIVE 02540022 C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS 32767. 02550022 C 02560022 IF (ICZERO) 36100, 6100, 36100 02570022 6100 CONTINUE 02580022 RADN11(5) = 32767. 02590022 IVCOMP = RADN11(5) 02600022 GO TO 46100 02610022 36100 IVDELE = IVDELE + 1 02620022 WRITE (I02,80003) IVTNUM 02630022 IF (ICZERO) 46100, 6111, 46100 02640022 46100 IF ( IVCOMP - 32767 ) 26100, 16100, 26100 02650022 16100 IVPASS = IVPASS + 1 02660022 WRITE (I02,80001) IVTNUM 02670022 GO TO 6111 02680022 26100 IVFAIL = IVFAIL + 1 02690022 IVCORR = 32767 02700022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02710022 6111 CONTINUE 02720022 IVTNUM = 611 02730022 C 02740022 C **** TEST 611 **** 02750022 C TEST 611 - TEST OF SETTING A REAL ARRAY ELEMENT TO A NEGATIVE 02760022 C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS -32766. 02770022 C 02780022 IF (ICZERO) 36110, 6110, 36110 02790022 6110 CONTINUE 02800022 RADN11(1) = -32766. 02810022 IVCOMP = RADN11(1) 02820022 GO TO 46110 02830022 36110 IVDELE = IVDELE + 1 02840022 WRITE (I02,80003) IVTNUM 02850022 IF (ICZERO) 46110, 6121, 46110 02860022 46110 IF ( IVCOMP + 32766 ) 26110, 16110, 26110 02870022 16110 IVPASS = IVPASS + 1 02880022 WRITE (I02,80001) IVTNUM 02890022 GO TO 6121 02900022 26110 IVFAIL = IVFAIL + 1 02910022 IVCORR = -32766 02920022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02930022 6121 CONTINUE 02940022 IVTNUM = 612 02950022 C 02960022 C **** TEST 612 **** 02970022 C TEST 612 - TEST OF SETTING A REAL ARRAY ELEMENT TO UNSIGNED ZERO02980022 C IN A SIMPLE ASSIGNMENT STATEMENT. 02990022 C 03000022 IF (ICZERO) 36120, 6120, 36120 03010022 6120 CONTINUE 03020022 RADN11(3) = 0. 03030022 IVCOMP = RADN11(3) 03040022 GO TO 46120 03050022 36120 IVDELE = IVDELE + 1 03060022 WRITE (I02,80003) IVTNUM 03070022 IF (ICZERO) 46120, 6131, 46120 03080022 46120 IF ( IVCOMP - 0 ) 26120, 16120, 26120 03090022 16120 IVPASS = IVPASS + 1 03100022 WRITE (I02,80001) IVTNUM 03110022 GO TO 6131 03120022 26120 IVFAIL = IVFAIL + 1 03130022 IVCORR = 0 03140022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03150022 6131 CONTINUE 03160022 IVTNUM = 613 03170022 C 03180022 C **** TEST 613 **** 03190022 C TEST 613 - TEST OF A NEGATIVELY SIGNED ZERO IN A REAL ARRAY 03200022 C ELEMENT COMPARED TO A REAL ELEMENT SET TO AN UNSIGNED ZERO. 03210022 C 03220022 IF (ICZERO) 36130, 6130, 36130 03230022 6130 CONTINUE 03240022 RADN11(2) = -0.0 03250022 RADN11(3) = 0.0 03260022 ICON01 = 0 03270022 IF ( RADN11(2) .EQ. RADN11(3) ) ICON01 = 1 03280022 GO TO 46130 03290022 36130 IVDELE = IVDELE + 1 03300022 WRITE (I02,80003) IVTNUM 03310022 IF (ICZERO) 46130, 6141, 46130 03320022 46130 IF ( ICON01 - 1 ) 26130, 16130, 26130 03330022 16130 IVPASS = IVPASS + 1 03340022 WRITE (I02,80001) IVTNUM 03350022 GO TO 6141 03360022 26130 IVFAIL = IVFAIL + 1 03370022 IVCOMP = ICON01 03380022 IVCORR = 1 03390022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03400022 6141 CONTINUE 03410022 IVTNUM = 614 03420022 C 03430022 C **** TEST 614 **** 03440022 C TEST 614 - TEST OF SETTING ONE REAL ARRAY ELEMENT EQUAL TO THE 03450022 C VALUE OF ANOTHER REAL ARRAY ELEMENT. THE VALUE IS 32767. 03460022 C 03470022 IF (ICZERO) 36140, 6140, 36140 03480022 6140 CONTINUE 03490022 RADN11(1) = 32767. 03500022 RADN12(5) = RADN11(1) 03510022 IVCOMP = RADN12(5) 03520022 GO TO 46140 03530022 36140 IVDELE = IVDELE + 1 03540022 WRITE (I02,80003) IVTNUM 03550022 IF (ICZERO) 46140, 6151, 46140 03560022 46140 IF ( IVCOMP - 32767 ) 26140, 16140, 26140 03570022 16140 IVPASS = IVPASS + 1 03580022 WRITE (I02,80001) IVTNUM 03590022 GO TO 6151 03600022 26140 IVFAIL = IVFAIL + 1 03610022 IVCORR = 32767 03620022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03630022 6151 CONTINUE 03640022 IVTNUM = 615 03650022 C 03660022 C **** TEST 615 **** 03670022 C TEST 615 - TEST OF A REAL ARRAY ELEMENT SET TO ANOTHER REAL 03680022 C ARRAY ELEMENT WHICH HAD BEEN SET AT COMPILE TIME BY A DATA 03690022 C INITIALIZATION STATEMENT. THE VALUE IS -512. 03700022 C 03710022 IF (ICZERO) 36150, 6150, 36150 03720022 6150 CONTINUE 03730022 RADN11(4) = RADN12(1) 03740022 IVCOMP = RADN11(4) 03750022 GO TO 46150 03760022 36150 IVDELE = IVDELE + 1 03770022 WRITE (I02,80003) IVTNUM 03780022 IF (ICZERO) 46150, 6161, 46150 03790022 46150 IF ( IVCOMP + 512 ) 26150, 16150, 26150 03800022 16150 IVPASS = IVPASS + 1 03810022 WRITE (I02,80001) IVTNUM 03820022 GO TO 6161 03830022 26150 IVFAIL = IVFAIL + 1 03840022 IVCORR = - 512 03850022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03860022 6161 CONTINUE 03870022 IVTNUM = 616 03880022 C 03890022 C **** TEST 616 **** 03900022 C TEST 616 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT03910022 C BY AN ARITHMETIC EXPRESSION. 03920022 C 03930022 IF (ICZERO) 36160, 6160, 36160 03940022 6160 CONTINUE 03950022 ICON01 = 1 03960022 IADN11(3) = ICON01 + 1 03970022 IVCOMP = IADN11(3) 03980022 GO TO 46160 03990022 36160 IVDELE = IVDELE + 1 04000022 WRITE (I02,80003) IVTNUM 04010022 IF (ICZERO) 46160, 6171, 46160 04020022 46160 IF ( IVCOMP - 2 ) 26160, 16160, 26160 04030022 16160 IVPASS = IVPASS + 1 04040022 WRITE (I02,80001) IVTNUM 04050022 GO TO 6171 04060022 26160 IVFAIL = IVFAIL + 1 04070022 IVCORR = 2 04080022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090022 6171 CONTINUE 04100022 IVTNUM = 617 04110022 C 04120022 C **** TEST 617 **** 04130022 C TEST 617 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04140022 C BY AN ARITHMETIC EXPRESSION. 04150022 C 04160022 IF (ICZERO) 36170, 6170, 36170 04170022 6170 CONTINUE 04180022 RCON01 = 1. 04190022 RADN11(3) = RCON01 + 1. 04200022 IVCOMP = RADN11(3) 04210022 GO TO 46170 04220022 36170 IVDELE = IVDELE + 1 04230022 WRITE (I02,80003) IVTNUM 04240022 IF (ICZERO) 46170, 6181, 46170 04250022 46170 IF ( IVCOMP - 2 ) 26170, 16170, 26170 04260022 16170 IVPASS = IVPASS + 1 04270022 WRITE (I02,80001) IVTNUM 04280022 GO TO 6181 04290022 26170 IVFAIL = IVFAIL + 1 04300022 IVCORR = 2 04310022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04320022 6181 CONTINUE 04330022 IVTNUM = 618 04340022 C 04350022 C **** TEST 618 **** 04360022 C TEST 618 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT04370022 C TO ANOTHER INTEGER ARRAY ELEMENT AND CHANGING THE SIGN. 04380022 C 04390022 IF (ICZERO) 36180, 6180, 36180 04400022 6180 CONTINUE 04410022 IADN11(2) = 32766 04420022 IADN11(4) = - IADN11(2) 04430022 IVCOMP = IADN11(4) 04440022 GO TO 46180 04450022 36180 IVDELE = IVDELE + 1 04460022 WRITE (I02,80003) IVTNUM 04470022 IF (ICZERO) 46180, 6191, 46180 04480022 46180 IF ( IVCOMP + 32766 ) 26180, 16180, 26180 04490022 16180 IVPASS = IVPASS + 1 04500022 WRITE (I02,80001) IVTNUM 04510022 GO TO 6191 04520022 26180 IVFAIL = IVFAIL + 1 04530022 IVCORR = -32766 04540022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04550022 6191 CONTINUE 04560022 IVTNUM = 619 04570022 C 04580022 C **** TEST 619 **** 04590022 C TEST 619 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04600022 C TO THE VALUE OF ANOTHER REAL ARRAY ELEMENT AND CHANGING THE SIGN. 04610022 C 04620022 IF (ICZERO) 36190, 6190, 36190 04630022 6190 CONTINUE 04640022 RADN11(2) = 32766. 04650022 RADN11(4) = - RADN11(2) 04660022 IVCOMP = RADN11(4) 04670022 GO TO 46190 04680022 36190 IVDELE = IVDELE + 1 04690022 WRITE (I02,80003) IVTNUM 04700022 IF (ICZERO) 46190, 6201, 46190 04710022 46190 IF ( IVCOMP + 32766 ) 26190, 16190, 26190 04720022 16190 IVPASS = IVPASS + 1 04730022 WRITE (I02,80001) IVTNUM 04740022 GO TO 6201 04750022 26190 IVFAIL = IVFAIL + 1 04760022 IVCORR = -32766 04770022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04780022 6201 CONTINUE 04790022 IVTNUM = 620 04800022 C 04810022 C **** TEST 620 **** 04820022 C TEST 620 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 04830022 C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT. 04840022 C 04850022 IF (ICZERO) 36200, 6200, 36200 04860022 6200 CONTINUE 04870022 LADN11(1) = .TRUE. 04880022 LADN12(1) = LADN11(1) 04890022 ICON01 = 0 04900022 IF ( LADN12(1) ) ICON01 = 1 04910022 GO TO 46200 04920022 36200 IVDELE = IVDELE + 1 04930022 WRITE (I02,80003) IVTNUM 04940022 IF (ICZERO) 46200, 6211, 46200 04950022 46200 IF ( ICON01 - 1 ) 26200, 16200, 26200 04960022 16200 IVPASS = IVPASS + 1 04970022 WRITE (I02,80001) IVTNUM 04980022 GO TO 6211 04990022 26200 IVFAIL = IVFAIL + 1 05000022 IVCOMP = ICON01 05010022 IVCORR = 1 05020022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030022 6211 CONTINUE 05040022 IVTNUM = 621 05050022 C 05060022 C **** TEST 621 **** 05070022 C TEST 621 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 05080022 C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT AND CHANGING 05090022 C THE VALUE FROM .TRUE. TO .FALSE. BY USING THE .NOT. STATEMENT. 05100022 C 05110022 IF (ICZERO) 36210, 6210, 36210 05120022 6210 CONTINUE 05130022 LADN11(2) = .TRUE. 05140022 LADN12(2) = .NOT. LADN11(2) 05150022 ICON01 = 1 05160022 IF ( LADN12(2) ) ICON01 = 0 05170022 GO TO 46210 05180022 36210 IVDELE = IVDELE + 1 05190022 WRITE (I02,80003) IVTNUM 05200022 IF (ICZERO) 46210, 6221, 46210 05210022 46210 IF ( ICON01 - 1 ) 26210, 16210, 26210 05220022 16210 IVPASS = IVPASS + 1 05230022 WRITE (I02,80001) IVTNUM 05240022 GO TO 6221 05250022 26210 IVFAIL = IVFAIL + 1 05260022 IVCOMP = ICON01 05270022 IVCORR = 1 05280022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05290022 6221 CONTINUE 05300022 IVTNUM = 622 05310022 C 05320022 C **** TEST 622 **** 05330022 C TEST 622 - TEST OF THE TYPE STATEMENT AND THE DATA 05340022 C INITIALIZATION STATEMENT. THE EXPLICITLY REAL ARRAY ELEMENT 05350022 C SHOULD HAVE THE VALUE OF .5 05360022 C 05370022 IF (ICZERO) 36220, 6220, 36220 05380022 6220 CONTINUE 05390022 IVCOMP = 2. * IADN13(1) 05400022 GO TO 46220 05410022 36220 IVDELE = IVDELE + 1 05420022 WRITE (I02,80003) IVTNUM 05430022 IF (ICZERO) 46220, 6231, 46220 05440022 46220 IF ( IVCOMP - 1 ) 26220, 16220, 26220 05450022 16220 IVPASS = IVPASS + 1 05460022 WRITE (I02,80001) IVTNUM 05470022 GO TO 6231 05480022 26220 IVFAIL = IVFAIL + 1 05490022 IVCORR = 1 05500022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05510022 6231 CONTINUE 05520022 IVTNUM = 623 05530022 C 05540022 C **** TEST 623 **** 05550022 C TEST 623 - TEST OF REAL TO INTEGER CONVERSION USING ARRAYS. 05560022 C THE INITIALIZED VALUE OF 0.5 SHOULD BE TRUNCATED TO ZERO. 05570022 C 05580022 IF (ICZERO) 36230, 6230, 36230 05590022 6230 CONTINUE 05600022 IADN11(1) = IADN13(1) 05610022 IVCOMP = IADN11(1) 05620022 GO TO 46230 05630022 36230 IVDELE = IVDELE + 1 05640022 WRITE (I02,80003) IVTNUM 05650022 IF (ICZERO) 46230, 6241, 46230 05660022 46230 IF ( IVCOMP - 0 ) 26230, 16230, 26230 05670022 16230 IVPASS = IVPASS + 1 05680022 WRITE (I02,80001) IVTNUM 05690022 GO TO 6241 05700022 26230 IVFAIL = IVFAIL + 1 05710022 IVCORR = 0 05720022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05730022 6241 CONTINUE 05740022 IVTNUM = 624 05750022 C 05760022 C **** TEST 624 **** 05770022 C TEST 624 - TEST OF THE COMMON STATEMENT BY SETTING THE VALUE OF 05780022 C AN INTEGER ARRAY ELEMENT IN A DIMENSIONED ARRAY TO THE VALUE 05790022 C OF A REAL ARRAY ELEMENT IN COMMON. THE ELEMENT IN COMMON HAD ITS 05800022 C VALUE SET IN A SIMPLE ASSIGNMENT STATEMENT TO 9999. 05810022 C 05820022 IF (ICZERO) 36240, 6240, 36240 05830022 6240 CONTINUE 05840022 RADN14(1) = 9999. 05850022 IADN11(1) = RADN14(1) 05860022 IVCOMP = IADN11(1) 05870022 GO TO 46240 05880022 36240 IVDELE = IVDELE + 1 05890022 WRITE (I02,80003) IVTNUM 05900022 IF (ICZERO) 46240, 6251, 46240 05910022 46240 IF ( IVCOMP - 9999 ) 26240, 16240, 26240 05920022 16240 IVPASS = IVPASS + 1 05930022 WRITE (I02,80001) IVTNUM 05940022 GO TO 6251 05950022 26240 IVFAIL = IVFAIL + 1 05960022 IVCORR = 9999 05970022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05980022 6251 CONTINUE 05990022 IVTNUM = 625 06000022 C 06010022 C **** TEST 625 **** 06020022 C TEST 625 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT06030022 C IN COMMON TO THE VALUE OF A REAL ARRAY ELEMENT ALSO IN BLANK 06040022 C COMMON AND CHANGING THE SIGN. THE VALUE USED IS 9999. 06050022 C 06060022 IF (ICZERO) 36250, 6250, 36250 06070022 6250 CONTINUE 06080022 RADN14(1) = 9999. 06090022 IADN14(1) = - RADN14(1) 06100022 IVCOMP = IADN14(1) 06110022 GO TO 46250 06120022 36250 IVDELE = IVDELE + 1 06130022 WRITE (I02,80003) IVTNUM 06140022 IF (ICZERO) 46250, 6261, 46250 06150022 46250 IF ( IVCOMP + 9999 ) 26250, 16250, 26250 06160022 16250 IVPASS = IVPASS + 1 06170022 WRITE (I02,80001) IVTNUM 06180022 GO TO 6261 06190022 26250 IVFAIL = IVFAIL + 1 06200022 IVCORR = - 9999 06210022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06220022 6261 CONTINUE 06230022 IVTNUM = 626 06240022 C 06250022 C **** TEST 626 **** 06260022 C TEST 626 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 06270022 C IN BLANK COMMON TO .NOT. .TRUE. 06280022 C THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT ALSO IN COMMON IS THEN 06290022 C SET TO .NOT. OF THE VALUE OF THE FIRST. 06300022 C VALUE OF THE FIRST ELEMENT SHOULD BE .FALSE. 06310022 C VALUE OF THE SECOND ELEMENT SHOULD BE .TRUE. 06320022 C 06330022 IF (ICZERO) 36260, 6260, 36260 06340022 6260 CONTINUE 06350022 LADN13(1) = .NOT. .TRUE. 06360022 LADN13(2) = .NOT. LADN13(1) 06370022 ICON01 = 0 06380022 IF ( LADN13(2) ) ICON01 = 1 06390022 GO TO 46260 06400022 36260 IVDELE = IVDELE + 1 06410022 WRITE (I02,80003) IVTNUM 06420022 IF (ICZERO) 46260, 6271, 46260 06430022 46260 IF ( ICON01 - 1 ) 26260, 16260, 26260 06440022 16260 IVPASS = IVPASS + 1 06450022 WRITE (I02,80001) IVTNUM 06460022 GO TO 6271 06470022 26260 IVFAIL = IVFAIL + 1 06480022 IVCOMP = ICON01 06490022 IVCORR = 1 06500022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06510022 6271 CONTINUE 06520022 IVTNUM = 627 06530022 C 06540022 C **** TEST 627 **** 06550022 C TEST 627 - TEST OF EQUIVALENCE ON THE FIRST ELEMENTS OF INTEGER 06560022 C ARRAYS ONE OF WHICH IS IN COMMON AND THE OTHER ONE IS DIMENSIONED.06570022 C 06580022 IF (ICZERO) 36270, 6270, 36270 06590022 6270 CONTINUE 06600022 IADN14(2) = 32767 06610022 IVCOMP = IADN15(2) 06620022 GO TO 46270 06630022 36270 IVDELE = IVDELE + 1 06640022 WRITE (I02,80003) IVTNUM 06650022 IF (ICZERO) 46270, 6281, 46270 06660022 46270 IF ( IVCOMP - 32767 ) 26270, 16270, 26270 06670022 16270 IVPASS = IVPASS + 1 06680022 WRITE (I02,80001) IVTNUM 06690022 GO TO 6281 06700022 26270 IVFAIL = IVFAIL + 1 06710022 IVCORR = 32767 06720022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06730022 6281 CONTINUE 06740022 IVTNUM = 628 06750022 C 06760022 C **** TEST 628 **** 06770022 C TEST 628 - TEST OF EQUIVALENCE ON REAL ARRAYS ONE OF WHICH IS 06780022 C IN COMMON AND THE OTHER ONE IS DIMENSIONED. THE ARRAYS WERE 06790022 C ALIGNED ON THEIR SECOND ELEMENTS. 06800022 C 06810022 IF (ICZERO) 36280, 6280, 36280 06820022 6280 CONTINUE 06830022 RADN15(1) = -32766. 06840022 IVCOMP = RADN14(1) 06850022 GO TO 46280 06860022 36280 IVDELE = IVDELE + 1 06870022 WRITE (I02,80003) IVTNUM 06880022 IF (ICZERO) 46280, 6291, 46280 06890022 46280 IF ( IVCOMP + 32766 ) 26280, 16280, 26280 06900022 16280 IVPASS = IVPASS + 1 06910022 WRITE (I02,80001) IVTNUM 06920022 GO TO 6291 06930022 26280 IVFAIL = IVFAIL + 1 06940022 IVCORR = -32766 06950022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06960022 6291 CONTINUE 06970022 IVTNUM = 629 06980022 C 06990022 C **** TEST 629 **** 07000022 C TEST 629 - TEST OF EQUIVALENCE WITH LOGICAL ELEMENTS. AN ARRAY 07010022 C ELEMENT IN COMMON IS EQUIVALENCED TO A LOGICAL VARIABLE. 07020022 C 07030022 IF (ICZERO) 36290, 6290, 36290 07040022 6290 CONTINUE 07050022 LADN13(2) = .TRUE. 07060022 LCTN01 = .NOT. LADN13(2) 07070022 ICON01 = 1 07080022 IF ( LADN13(1) ) ICON01 = 0 07090022 GO TO 46290 07100022 36290 IVDELE = IVDELE + 1 07110022 WRITE (I02,80003) IVTNUM 07120022 IF (ICZERO) 46290, 6301, 46290 07130022 46290 IF ( ICON01 - 1 ) 26290, 16290, 26290 07140022 16290 IVPASS = IVPASS + 1 07150022 WRITE (I02,80001) IVTNUM 07160022 GO TO 6301 07170022 26290 IVFAIL = IVFAIL + 1 07180022 IVCOMP = ICON01 07190022 IVCORR = 1 07200022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07210022 6301 CONTINUE 07220022 IVTNUM = 630 07230022 C 07240022 C **** TEST 630 **** 07250022 C TEST 630 - TEST OF EQUIVALENCE WITH REAL AND INTEGER ELEMENTS 07260022 C WHICH ARE EQUIVALENCED TO ARRAY ELEMENTS IN COMMON. 07270022 C 07280022 IF (ICZERO) 36300, 6300, 36300 07290022 6300 CONTINUE 07300022 RCON01 = 1. 07310022 ICON02 = - RADN14(5) 07320022 IVCOMP = IADN14(5) 07330022 GO TO 46300 07340022 36300 IVDELE = IVDELE + 1 07350022 WRITE (I02,80003) IVTNUM 07360022 IF (ICZERO) 46300, 6311, 46300 07370022 46300 IF ( IVCOMP + 1 ) 26300, 16300, 26300 07380022 16300 IVPASS = IVPASS + 1 07390022 WRITE (I02,80001) IVTNUM 07400022 GO TO 6311 07410022 26300 IVFAIL = IVFAIL + 1 07420022 IVCORR = -1 07430022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07440022 6311 CONTINUE 07450022 IVTNUM = 631 07460022 C 07470022 C **** TEST 631 **** 07480022 C TEST 631 - TEST OF EQUIVALENCE ON INTEGER ARRAY ELEMENTS. 07490022 C BOTH ARRAYS ARE DIMENSIONED. THE FOURTH ELEMENT 07500022 C OF THE FIRST OF THE ARRAYS SHOULD BE EQUAL TO THE THIRD ELEMENT OF07510022 C THE SECOND ARRAY. 07520022 C 07530022 IF (ICZERO) 36310, 6310, 36310 07540022 6310 CONTINUE 07550022 IADN16(4) = 9999 07560022 IVCOMP = IADN17(3) 07570022 GO TO 46310 07580022 36310 IVDELE = IVDELE + 1 07590022 WRITE (I02,80003) IVTNUM 07600022 IF (ICZERO) 46310, 6321, 46310 07610022 46310 IF ( IVCOMP - 9999 ) 26310, 16310, 26310 07620022 16310 IVPASS = IVPASS + 1 07630022 WRITE (I02,80001) IVTNUM 07640022 GO TO 6321 07650022 26310 IVFAIL = IVFAIL + 1 07660022 IVCORR = 9999 07670022 WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07680022 6321 CONTINUE 07690022 C 07700022 C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07710022 99999 CONTINUE 07720022 WRITE (I02,90002) 07730022 WRITE (I02,90006) 07740022 WRITE (I02,90002) 07750022 WRITE (I02,90002) 07760022 WRITE (I02,90007) 07770022 WRITE (I02,90002) 07780022 WRITE (I02,90008) IVFAIL 07790022 WRITE (I02,90009) IVPASS 07800022 WRITE (I02,90010) IVDELE 07810022 C 07820022 C 07830022 C TERMINATE ROUTINE EXECUTION 07840022 STOP 07850022 C 07860022 C FORMAT STATEMENTS FOR PAGE HEADERS 07870022 90000 FORMAT ("1") 07880022 90002 FORMAT (" ") 07890022 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07900022 90003 FORMAT (" ",21X,"VERSION 2.1" ) 07910022 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07920022 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07930022 90006 FORMAT (" ",5X,"----------------------------------------------" ) 07940022 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07950022 C 07960022 C FORMAT STATEMENTS FOR RUN SUMMARIES 07970022 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07980022 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07990022 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08000022 C 08010022 C FORMAT STATEMENTS FOR TEST RESULTS 08020022 80001 FORMAT (" ",4X,I5,7X,"PASS") 08030022 80002 FORMAT (" ",4X,I5,7X,"FAIL") 08040022 80003 FORMAT (" ",4X,I5,7X,"DELETED") 08050022 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08060022 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08070022 C 08080022 90007 FORMAT (" ",20X,"END OF PROGRAM FM022" ) 08090022 END 08100022