C     COMMENT SECTION
C
C     FM041
C
C         THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE
C     FORM      INTEGER VARIABLE =  PRIMARY ** PRIMARY
C     WHERE THE FIRST OF TWO PRIMARIES IS AN INTEGER VARIABLE OR AN
C     INTEGER CONSTANT AND THE SECOND PRIMARY IS AN INTEGER CONSTANT.
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 10.1, ARITHMETIC ASSIGNMENT STATEMENT
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     TEST SECTION
C
C         ARITHMETIC ASSIGNMENT STATEMENT
C
C     TEST 615 THROUGH TEST 631 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C     OF THE FORM    INTEGER VARIABLE = INTEGER CONSTANT ** INTEGER CON.
C
C     TEST 632 THROUGH TEST 648 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS
C     OF THE FORM    INTEGER VARIABLE = INTEGER VARIABLE ** INTEGER CON.
C
C
      IVTNUM = 615
C
C      ****  TEST 615  ****
C     TEST 615  - SMALL NUMBER BASE; ZERO EXPONENT
C
      IF (ICZERO) 36150, 6150, 36150
 6150 CONTINUE
      IVCOMP = 1 ** 0
      GO TO 46150
36150 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46150, 6161, 46150
46150 IF (IVCOMP - 1) 26150,16150,26150
16150 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6161
26150 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6161 CONTINUE
      IVTNUM = 616
C
C      ****  TEST 616  ****
C     TEST 616  - ZERO BASE TO FIRST POWER
C
      IF (ICZERO) 36160, 6160, 36160
 6160 CONTINUE
      IVCOMP = 0 ** 1
      GO TO 46160
36160 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46160, 6171, 46160
46160 IF (IVCOMP) 26160,16160,26160
16160 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6171
26160 IVFAIL = IVFAIL + 1
      IVCORR = 0
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6171 CONTINUE
      IVTNUM = 617
C
C      ****  TEST 617  ****
C     TEST 617  - BASE =1; EXPONENT = 1
C
      IF (ICZERO) 36170, 6170, 36170
 6170 CONTINUE
      IVCOMP = 1 ** 1
      GO TO 46170
36170 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46170, 6181, 46170
46170 IF (IVCOMP - 1) 26170,16170,26170
16170 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6181
26170 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6181 CONTINUE
      IVTNUM = 618
C
C      ****  TEST 618  ****
C     TEST 618  - LARGE NUMBER BASE; EXPONENT = 1
C
      IF (ICZERO) 36180, 6180, 36180
 6180 CONTINUE
      IVCOMP = 32767 ** 1
      GO TO 46180
36180 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46180, 6191, 46180
46180 IF (IVCOMP - 32767) 26180,16180,26180
16180 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6191
26180 IVFAIL = IVFAIL + 1
      IVCORR = 32767
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6191 CONTINUE
      IVTNUM = 619
C
C      ****  TEST 619  ****
C     TEST 619  - LARGE EXPONENT
C
      IF (ICZERO) 36190, 6190, 36190
 6190 CONTINUE
      IVCOMP = 1 ** 32767
      GO TO 46190
36190 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46190, 6201, 46190
46190 IF (IVCOMP - 1) 26190,16190,26190
16190 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6201
26190 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6201 CONTINUE
      IVTNUM = 620
C
C      ****  TEST 620  ****
C     TEST 620  - ZERO BASE; LARGE NUMBER EXPONENT
C
      IF (ICZERO) 36200, 6200, 36200
 6200 CONTINUE
      IVCOMP = 0 ** 32767
      GO TO 46200
36200 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46200, 6211, 46200
46200 IF (IVCOMP) 26200,16200,26200
16200 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6211
26200 IVFAIL = IVFAIL + 1
      IVCORR = 0
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6211 CONTINUE
      IVTNUM = 621
C
C      ****  TEST 621  ****
C     TEST 621  -LARGE NUMBER BASE; ZERO EXPONENT
C
      IF (ICZERO) 36210, 6210, 36210
 6210 CONTINUE
      IVCOMP = 32767 ** 0
      GO TO 46210
36210 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46210, 6221, 46210
46210 IF (IVCOMP - 1) 26210,16210,26210
16210 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6221
26210 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6221 CONTINUE
      IVTNUM = 622
C
C      ****  TEST 622  ****
C     TEST 622  -EXPONENT IS POWER OF TWO
C
      IF (ICZERO) 36220, 6220, 36220
 6220 CONTINUE
      IVCOMP = 181 ** 2
      GO TO 46220
36220 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46220, 6231, 46220
46220 IF (IVCOMP - 32761) 26220,16220,26220
16220 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6231
26220 IVFAIL = IVFAIL + 1
      IVCORR = 32761
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6231 CONTINUE
      IVTNUM = 623
C
C      ****  TEST 623  ****
C     TEST 623  - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
      IF (ICZERO) 36230, 6230, 36230
 6230 CONTINUE
      IVCOMP = 2 ** 8
      GO TO 46230
36230 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46230, 6241, 46230
46230 IF (IVCOMP - 256) 26230,16230,26230
16230 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6241
26230 IVFAIL = IVFAIL + 1
      IVCORR = 256
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6241 CONTINUE
C
C     TESTS 624 AND 625 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C                       NOT COMMUTATIVE
C
      IVTNUM = 624
C
C      ****  TEST 624  ****
C
      IF (ICZERO) 36240, 6240, 36240
 6240 CONTINUE
      IVCOMP = 3 ** 9
      GO TO 46240
36240 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46240, 6251, 46240
46240 IF (IVCOMP - 19683) 26240,16240,26240
16240 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6251
26240 IVFAIL = IVFAIL + 1
      IVCORR = 19683
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6251 CONTINUE
      IVTNUM = 625
C
C      ****  TEST 625  ****
C
      IF (ICZERO) 36250, 6250, 36250
 6250 CONTINUE
      IVCOMP = 9 ** 3
      GO TO 46250
36250 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46250, 6261, 46250
46250 IF (IVCOMP - 729) 26250,16250,26250
16250 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6261
26250 IVFAIL = IVFAIL + 1
      IVCORR = 729
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6261 CONTINUE
C
C     TESTS 626 THROUGH 631 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C                           ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C                           OF THE RESULTS
C
      IVTNUM = 626
C
C      ****  TEST 626  ****
C
      IF (ICZERO) 36260, 6260, 36260
 6260 CONTINUE
      IVCOMP = 1 ** 2
      GO TO 46260
36260 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46260, 6271, 46260
46260 IF (IVCOMP - 1) 26260,16260,26260
16260 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6271
26260 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6271 CONTINUE
      IVTNUM = 627
C
C      ****  TEST 627  ****
C
      IF (ICZERO) 36270, 6270, 36270
 6270 CONTINUE
      IVCOMP= (-1) ** 2
      GO TO 46270
36270 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46270, 6281, 46270
46270 IF (IVCOMP - 1) 26270,16270,26270
16270 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6281
26270 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6281 CONTINUE
      IVTNUM = 628
C
C      ****  TEST 628  ****
C
      IF (ICZERO) 36280, 6280, 36280
 6280 CONTINUE
      IVCOMP = 7 ** 3
      GO TO 46280
36280 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46280, 6291, 46280
46280 IF (IVCOMP - 343) 26280,16280,26280
16280 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6291
26280 IVFAIL = IVFAIL + 1
      IVCORR = 343
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6291 CONTINUE
      IVTNUM = 629
C
C      ****  TEST 629  ****
C
      IF (ICZERO) 36290, 6290, 36290
 6290 CONTINUE
      IVCOMP = (-7) ** 3
      GO TO 46290
36290 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46290, 6301, 46290
46290 IF (IVCOMP + 343) 26290,16290,26290
16290 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6301
26290 IVFAIL = IVFAIL + 1
      IVCORR = -343
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6301 CONTINUE
      IVTNUM = 630
C
C      ****  TEST 630  ****
C
      IF (ICZERO) 36300, 6300, 36300
 6300 CONTINUE
      IVCOMP = 7 ** 4
      GO TO 46300
36300 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46300, 6311, 46300
46300 IF (IVCOMP - 2401) 26300,16300,26300
16300 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6311
26300 IVFAIL = IVFAIL + 1
      IVCORR = 2401
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6311 CONTINUE
      IVTNUM = 631
C
C      ****  TEST 631  ****
C
      IF (ICZERO) 36310, 6310, 36310
 6310 CONTINUE
      IVCOMP = (-7) ** 4
      GO TO 46310
36310 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46310, 6321, 46310
46310 IF (IVCOMP - 2401) 26310,16310,26310
16310 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6321
26310 IVFAIL = IVFAIL + 1
      IVCORR = 2401
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6321 CONTINUE
      IVTNUM = 632
C
C      ****  TEST 632  ****
C     TEST 632  - SMALL NUMBER BASE; ZERO EXPONENT
C
      IF (ICZERO) 36320, 6320, 36320
 6320 CONTINUE
      IVON01 = 1
      IVCOMP = IVON01 ** 1
      GO TO 46320
36320 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46320, 6331, 46320
46320 IF (IVCOMP - 1) 26320,16320,26320
16320 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6331
26320 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6331 CONTINUE
      IVTNUM = 633
C
C      ****  TEST 633  ****
C     TEST 633  - ZERO BASE TO FIRST POWER
C
      IF (ICZERO) 36330, 6330, 36330
 6330 CONTINUE
      IVON01 = 0
      IVCOMP = IVON01 ** 1
      GO TO 46330
36330 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46330, 6341, 46330
46330 IF (IVCOMP) 26330,16330,26330
16330 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6341
26330 IVFAIL = IVFAIL + 1
      IVCORR = 0
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6341 CONTINUE
      IVTNUM = 634
C
C      ****  TEST 634  ****
C     TEST 634  - BASE =1; EXPONENT = 1
C
      IF (ICZERO) 36340, 6340, 36340
 6340 CONTINUE
      IVON01 = 1
      IVCOMP = IVON01 ** 1
      GO TO 46340
36340 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46340, 6351, 46340
46340 IF (IVCOMP - 1) 26340,16340,26340
16340 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6351
26340 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6351 CONTINUE
      IVTNUM = 635
C
C      ****  TEST 635  ****
C     TEST 635  - LARGE EXPONENT
C
      IF (ICZERO) 36350, 6350, 36350
 6350 CONTINUE
      IVON01 = 1
      IVCOMP = IVON01 ** 32767
      GO TO 46350
36350 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46350, 6361, 46350
46350 IF (IVCOMP - 1) 26350,16350,26350
16350 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6361
26350 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6361 CONTINUE
      IVTNUM = 636
C
C      ****  TEST 636  ****
C     TEST 636  - LARGE NUMBER BASE; EXPONENT = 1
C
      IF (ICZERO) 36360, 6360, 36360
 6360 CONTINUE
      IVON01 = 32767
      IVCOMP = IVON01 ** 1
      GO TO 46360
36360 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46360, 6371, 46360
46360 IF (IVCOMP - 32767) 26360,16360,26360
16360 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6371
26360 IVFAIL = IVFAIL + 1
      IVCORR = 32767
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6371 CONTINUE
      IVTNUM = 637
C
C      ****  TEST 637  ****
C     TEST 637  - ZERO BASE; LARGE NUMBER EXPONENT
C
      IF (ICZERO) 36370, 6370, 36370
 6370 CONTINUE
      IVON01 = 0
      IVCOMP = IVON01 ** 32767
      GO TO 46370
36370 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46370, 6381, 46370
46370 IF (IVCOMP) 26370,16370,26370
16370 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6381
26370 IVFAIL = IVFAIL +1
      IVCORR = 0
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6381 CONTINUE
      IVTNUM = 638
C
C      ****  TEST 638  ****
C     TEST 638  -LARGE NUMBER BASE; ZERO EXPONENT
C
      IF (ICZERO) 36380, 6380, 36380
 6380 CONTINUE
      IVON01 = 32767
      IVCOMP = IVON01 ** 0
      GO TO 46380
36380 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46380, 6391, 46380
46380 IF (IVCOMP - 1) 26380,16380,26380
16380 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6391
26380 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6391 CONTINUE
      IVTNUM = 639
C
C      ****  TEST 639  ****
C     TEST 639  -EXPONENT IS POWER OF TWO
C
      IF (ICZERO) 36390, 6390, 36390
 6390 CONTINUE
      IVON01 = 181
      IVCOMP = IVON01 ** 2
      GO TO 46390
36390 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46390, 6401, 46390
46390 IF (IVCOMP - 32761) 26390,16390,26390
16390 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6401
26390 IVFAIL = IVFAIL + 1
      IVCORR = 32761
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6401 CONTINUE
      IVTNUM = 640
C
C      ****  TEST 640  ****
C     TEST 640  - BASE AND EXPONENT ARE BOTH POWERS OF TWO
C
      IF (ICZERO) 36400, 6400, 36400
 6400 CONTINUE
      IVON01 = 2
      IVCOMP = IVON01 ** 8
      GO TO 46400
36400 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46400, 6411, 46400
46400 IF (IVCOMP - 256) 26400,16400,26400
16400 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6411
26400 IVFAIL = IVFAIL + 1
      IVCORR = 256
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6411 CONTINUE
C
C     TESTS 641 AND 642 TEST TO ENSURE EXPONENTIATION OPERATOR IS
C                       NOT COMMUTATIVE
C
      IVTNUM = 641
C
C      ****  TEST 641  ****
C
      IF (ICZERO) 36410, 6410, 36410
 6410 CONTINUE
      IVON01 = 3
      IVCOMP = IVON01 ** 9
      GO TO 46410
36410 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46410, 6421, 46410
46410 IF (IVCOMP - 19683) 26410,16410,26410
16410 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6421
26410 IVFAIL = IVFAIL + 1
      IVCORR = 19683
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6421 CONTINUE
      IVTNUM = 642
C
C      ****  TEST 642  ****
C
      IF (ICZERO) 36420, 6420, 36420
 6420 CONTINUE
      IVON01 = 9
      IVCOMP = IVON01 ** 3
      GO TO 46420
36420 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46420, 6431, 46420
46420 IF (IVCOMP - 729) 26420,16420,26420
16420 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6431
26420 IVFAIL = IVFAIL + 1
      IVCORR = 729
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6431 CONTINUE
C
C     TESTS 643 THROUGH 648 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE
C                           ODD AND EVEN NUMBER POWERS CHECKING THE SIGN
C                           OF THE RESULTS
C
      IVTNUM = 643
C
C      ****  TEST 643  ****
C
      IF (ICZERO) 36430, 6430, 36430
 6430 CONTINUE
      IVON01 = 1
      IVCOMP = IVON01 ** 2
      GO TO 46430
36430 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46430, 6441, 46430
46430 IF (IVCOMP - 1) 26430,16430,26430
16430 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6441
26430 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6441 CONTINUE
      IVTNUM = 644
C
C      ****  TEST 644  ****
C
      IF (ICZERO) 36440, 6440, 36440
 6440 CONTINUE
      IVON01 = -1
      IVCOMP = IVON01 ** 2
      GO TO 46440
36440 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46440, 6451, 46440
46440 IF (IVCOMP - 1) 26440,16440,26440
16440 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6451
26440 IVFAIL = IVFAIL + 1
      IVCORR = 1
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6451 CONTINUE
      IVTNUM = 645
C
C      ****  TEST 645  ****
C
      IF (ICZERO) 36450, 6450, 36450
 6450 CONTINUE
      IVON01 = 7
      IVCOMP = IVON01 ** 3
      GO TO 46450
36450 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46450, 6461, 46450
46450 IF (IVCOMP - 343) 26450,16450,26450
16450 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6461
26450 IVFAIL = IVFAIL + 1
      IVCORR = 343
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6461 CONTINUE
      IVTNUM = 646
C
C      ****  TEST 646  ****
C
      IF (ICZERO) 36460, 6460, 36460
 6460 CONTINUE
      IVON01 = -7
      IVCOMP = IVON01 ** 3
      GO TO 46460
36460 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46460, 6471, 46460
46460 IF (IVCOMP + 343) 26460,16460,26460
16460 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6471
26460 IVFAIL = IVFAIL + 1
      IVCORR = -343
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6471 CONTINUE
      IVTNUM = 647
C
C      ****  TEST 647  ****
C
      IF (ICZERO) 36470, 6470, 36470
 6470 CONTINUE
      IVON01 = 7
      IVCOMP = IVON01 ** 4
      GO TO 46470
36470 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46470, 6481, 46470
46470 IF (IVCOMP - 2401) 26470,16470,26470
16470 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6481
26470 IVFAIL = IVFAIL + 1
      IVCORR = 2401
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6481 CONTINUE
      IVTNUM = 648
C
C      ****  TEST 648  ****
C
      IF (ICZERO) 36480, 6480, 36480
 6480 CONTINUE
      IVON01 = -7
      IVCOMP = IVON01 ** 4
      GO TO 46480
36480 IVDELE = IVDELE + 1
      WRITE (I02,80003) IVTNUM
      IF (ICZERO) 46480, 6491, 46480
46480 IF (IVCOMP - 2401) 26480,16480,26480
16480 IVPASS = IVPASS + 1
      WRITE (I02,80001) IVTNUM
      GO TO 6491
26480 IVFAIL = IVFAIL + 1
      IVCORR = 2401
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
 6491 CONTINUE
C      ***    END OF TESTS    ***
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 FM041)
      END