C     COMMENT SECTION
C
C     FM045
C
C         THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS USING INTEGER
C     VARIABLES CONNECTED BY A SERIES OF ARITHMETIC OPERATORS.
C     DIFFERENT COMBINATIONS OF PARENTHETICAL NOTATION ARE EXERCIZED.
C
C
C      REFERENCES
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C              X3.9-1978
C
C        SECTION 4.3, INTEGER TYPE
C        SECTION 4.3.1, INTEGER CONSTANT
C        SECTION 6.1, ARITHMETIC EXPRESSIONS
C        SECTION 6.6, EVALUATION OF EXPRESSIONS
C        SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT
C
C
C
C      **********************************************************
C
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C     OF EXECUTING THESE TESTS.
C
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C                  DEPARTMENT OF THE NAVY
C                  FEDERAL COBOL COMPILER TESTING SERVICE
C                  WASHINGTON, D.C.  20376
C
C      **********************************************************
C
C
C
C     INITIALIZATION SECTION
C
C     INITIALIZE CONSTANTS
C      **************
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
      I01 = 5
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
      I02 = 6
C     SYSTEM ENVIRONMENT SECTION
C
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C     (UNIT NUMBER FOR CARD READER).
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C     (UNIT NUMBER FOR PRINTER).
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
      IVPASS=0
      IVFAIL=0
      IVDELE=0
      ICZERO=0
C
C     WRITE PAGE HEADERS
      WRITE (I02,90000)
      WRITE (I02,90001)
      WRITE (I02,90002)
      WRITE (I02, 90002)
      WRITE (I02,90003)
      WRITE (I02,90002)
      WRITE (I02,90004)
      WRITE (I02,90002)
      WRITE (I02,90011)
      WRITE (I02,90002)
      WRITE (I02,90002)
      WRITE (I02,90005)
      WRITE (I02,90006)
      WRITE (I02,90002)
C
C
C     TEST SECTION
C
C         ARITHMETIC ASSIGNMENT STATEMENT
C
C
C     TESTS 747 THROUGH 755 USE THE SAME STRING OF VARIABLES AND
C     OPERATORS, BUT USE DIFFERENT COMBINATIONS OF PARENTHETICAL
C     NOTATION  TO ALTER PRIORITIES IN ORDER OF EVALUATION.
C
C     TESTS 756 THROUGH 759 CHECK THE CAPABILITY TO ENCLOSE THE ENTIRE
C     RIGHT HAND SIDE OF AN ASSIGNMENT STATEMENT IN PARENTHESES OR SETS
C     OF NESTED PARENTHESES.
C
C
C
C
C
C
C
      IVTNUM = 747
C
C      ****  TEST 747  ****
C
      IF (ICZERO) 37470, 7470, 37470
 7470 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 18
      IVON05 =  6
      IVON06 =  2
      IVCOMP = IVON01 + IVON02 - IVON03 * IVON04 / IVON05 ** IVON06
      GO TO 47470
37470 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47470, 7481, 47470
47470 IF (IVCOMP - 22) 27470,17470,27470
17470 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7481
27470 IVFAIL = IVFAIL + 1
      IVCORR = 22
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7481 CONTINUE
      IVTNUM = 748
C
C      ****  TEST 748  ****
C
      IF (ICZERO) 37480, 7480, 37480
 7480 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 18
      IVON05 =  6
      IVON06 =  2
      IVCOMP = ((((IVON01 + IVON02) - IVON03) * IVON04) / IVON05)
     *         ** IVON06
      GO TO 47480
37480 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47480, 7491, 47480
47480 IF (IVCOMP - 3600) 27480,17480,27480
17480 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7491
27480 IVFAIL = IVFAIL + 1
      IVCORR = 3600
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7491 CONTINUE
      IVTNUM = 749
C
C      ****  TEST 749  ****
C
      IF (ICZERO) 37490, 7490, 37490
 7490 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = (IVON01 + IVON02 - IVON03) * (IVON04 / IVON05 ** IVON06)
      GO TO 47490
37490 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47490, 7501, 47490
47490 IF (IVCOMP - 20) 27490,17490,27490
17490 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7501
27490 IVFAIL = IVFAIL + 1
      IVCORR = 20
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7501 CONTINUE
      IVTNUM = 750
C
C      ****  TEST 750  ****
C
      IF (ICZERO) 37500, 7500, 37500
 7500 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04) / (IVON05 **
     *         IVON06)
      GO TO 47500
37500 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47500, 7511, 47500
47500 IF (IVCOMP - 20) 27500,17500,27500
17500 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7511
27500 IVFAIL = IVFAIL + 1
      IVCORR = 20
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7511 CONTINUE
      IVTNUM = 751
C
C      ****  TEST 751  ****
C
      IF (ICZERO) 37510, 7510, 37510
 7510 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = ((IVON01 + IVON02) - (IVON03 * IVON04)) / (IVON05 **
     *         IVON06)
      GO TO 47510
37510 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO)  47510, 7521, 47510
47510 IF (IVCOMP + 3)  27510,17510,27510
17510 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7521
27510 IVFAIL = IVFAIL + 1
      IVCORR = -3
C     ACTUAL ANSWER IS  -3.333333...     TRUNCATION IS NECESSARY
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7521 CONTINUE
      IVTNUM = 752
C
C      ****  TEST 752  ****
C
      IF (ICZERO) 37520, 7520, 37520
 7520 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04 / IVON05) ** IVON06
      GO TO 47520
37520 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47520, 7531, 47520
47520 IF (IVCOMP + 552) 27520,17520,27520
17520 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7531
27520 IVFAIL = IVFAIL + 1
      IVCORR = -552
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7531 CONTINUE
      IVTNUM = 753
C
C      ****  TEST 753  ****
C
      IF (ICZERO) 37530, 7530, 37530
 7530 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = IVON01 + (IVON02 - IVON03 * IVON04) / IVON05 ** IVON06
      GO TO 47530
37530 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47530, 7541, 47530
47530 IF (IVCOMP - 12) 27530,17530,27530
17530 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7541
27530 IVFAIL = IVFAIL + 1
      IVCORR = 12
C     ACTUAL ANSWER IS  11.25            TRUNCATION IS NECESSARY
C                                        DURING AN INTERMEDIATE STEP
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7541 CONTINUE
      IVTNUM = 754
C
C      ****  TEST 754  ****
C
      IF (ICZERO) 37540, 7540, 37540
 7540 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = IVON01 + (IVON02 - IVON03) * (IVON04 / IVON05) ** IVON06
      GO TO 47540
37540 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47540, 7551, 47540
47540 IF (IVCOMP - 195) 27540,17540,27540
17540 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7551
27540 IVFAIL = IVFAIL + 1
      IVCORR = 195
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7551 CONTINUE
      IVTNUM = 755
C
C      ****  TEST 755  ****
C
      IF (ICZERO) 37550, 7550, 37550
 7550 CONTINUE
      IVON01 = 15
      IVON02 =  9
      IVON03 =  4
      IVON04 = 36
      IVON05 =  6
      IVON06 =  2
      IVCOMP = ((IVON01 + (IVON02 - IVON03) * IVON04) / IVON05) **
     *         IVON06
      GO TO 47550
37550 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47550, 7561, 47550
47550 IF (IVCOMP - 1024)  27550,17550,27550
17550 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7561
27550 IVFAIL = IVFAIL + 1
      IVCORR = 1024
C     ACTUAL ANSWER IS  1056.25         TRUNCATION IS NECESSARY
C                                       DURING AN INTERMEDIATE STEP
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7561 CONTINUE
      IVTNUM = 756
C
C      ****  TEST 756  ****
C          SINGLE PARENTHESES
C
      IF (ICZERO) 37560, 7560, 37560
 7560 CONTINUE
      IVON01 = 13
      IVON02 = 37
      IVCOMP = (IVON01 + IVON02)
      GO TO 47560
37560 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47560, 7571, 47560
47560 IF (IVCOMP - 50) 27560,17560,27560
17560 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7571
27560 IVFAIL = IVFAIL + 1
      IVCORR = 50
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7571 CONTINUE
      IVTNUM = 757
C
C      ****  TEST 757  ****
C          NESTED PARENTHESES (TWO SETS)
C
      IF (ICZERO) 37570, 7570, 37570
 7570 CONTINUE
      IVON01 = 13
      IVON02 = 37
      IVCOMP = ((IVON01 - IVON02))
      GO TO 47570
37570 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47570, 7581, 47570
47570 IF (IVCOMP + 24) 27570,17570,27570
17570 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7581
27570 IVFAIL = IVFAIL + 1
      IVCORR = -24
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7581 CONTINUE
      IVTNUM = 758
C
C      ****  TEST 758  ****
C          NESTED PARENTHESES (21 SETS - SAME LINE)
C
      IF (ICZERO) 37580, 7580, 37580
 7580 CONTINUE
      IVON01 = 13
      IVON02 = 37
      IVCOMP = (((((((((((((((((((((IVON01 * IVON02)))))))))))))))))))))
      GO TO 47580
37580 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47580, 7591, 47580
47580 IF (IVCOMP - 481) 27580,17580,27580
17580 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7591
27580 IVFAIL = IVFAIL + 1
      IVCORR = 481
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7591 CONTINUE
      IVTNUM = 759
C
C      ****  TEST 759  ****
C          NESTED PARENTHESES (57 SETS - MULTIPLE LINES)
C
      IF (ICZERO) 37590, 7590, 37590
 7590 CONTINUE
      IVON01 = 13
      IVON02 = 37
      IVCOMP = (((((((((((((((((((((((((((((((((((((((((((((((((((((((((
     *         IVON01 / IVON02
     *         )))))))))))))))))))))))))))))))))))))))))))))))))))))))))
      GO TO 47590
37590 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 47590, 7601, 47590
47590 IF (IVCOMP) 27590,17590,27590
17590 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 7601
27590 IVFAIL = IVFAIL + 1
      IVCORR = 0
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR
 7601 CONTINUE
C
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
      WRITE (I02,90002)
      WRITE (I02,90006)
      WRITE (I02,90002)
      WRITE (I02,90002)
      WRITE (I02,90007)
      WRITE (I02,90002)
      WRITE (I02,90008)  IVFAIL
      WRITE (I02,90009) IVPASS
      WRITE (I02,90010) IVDELE
C
C
C     TERMINATE ROUTINE EXECUTION
      STOP
C
C     FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C     FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C     FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM045)
      END