text:
      PROGRAM FM061

C     COMMENT SECTION                                                   00010061
C                                                                       00020061
C     FM061                                                             00030061
C                                                                       00040061
C          THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE   00050061
C     FORM                                                              00060061
C                   INTEGER VARIABLE = REAL CONSTANT                    00070061
C                   INTEGER VARIABLE = REAL VARIABLE                    00080061
C                   REAL VARIABLE = INTEGER VARIABLE                    00090061
C                   REAL VARIABLE = INTEGER CONSTANT                    00100061
C                                                                       00110061
C     THE CONSTANTS AND VARIABLES CONTAIN BOTH POSITIVE AND NEGATIVE    00120061
C     VALUES.                                                           00130061
C                                                                       00140061
C           A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00150061
C     REAL NUMBER.  IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES.   00160061
C                                                                       00170061
C          A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A       00180061
C     DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER.  BOTH   00190061
C     THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS;      00200061
C     EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH.  THE       00210061
C     CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A 00220061
C     DECIMAL NUMERAL.                                                  00230061
C                                                                       00240061
C         A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00250061
C     OPTIONALLY SIGNED INTEGER CONSTANT.                               00260061
C                                                                       00270061
C         A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00280061
C     A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN       00290061
C     INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT.                  00300061
C                                                                       00310061
C      REFERENCES                                                       00320061
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00330061
C              X3.9-1978                                                00340061
C                                                                       00350061
C        SECTION 4.4, REAL TYPE                                         00360061
C        SECTION 4.4.1, REAL CONSTANT                                   00370061
C        SECTION 6.1, ARITHMETIC EXPRESSIONS                            00380061
C        SECTION 6.6, EVALUATION OF EXPRESSIONS                         00390061
C        SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT                  00400061
C        SECTION 11.4, ARITHMETIC IF STATEMENT                          00410061
C                                                                       00420061
C      **********************************************************       00430061
C                                                                       00440061
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00450061
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00460061
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00470061
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00480061
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00490061
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00500061
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00510061
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00520061
C     OF EXECUTING THESE TESTS.                                         00530061
C                                                                       00540061
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00550061
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00560061
C                                                                       00570061
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00580061
C                                                                       00590061
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00600061
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00610061
C                          BUILDING 225  RM A266                        00620061
C                         GAITHERSBURG, MD  20899                       00630061
C      **********************************************************       00640061
C                                                                       00650061
C                                                                       00660061
C                                                                       00670061
C     INITIALIZATION SECTION                                            00680061
C                                                                       00690061
C     INITIALIZE CONSTANTS                                              00700061
C      **************                                                   00710061
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00720061
      I01 = 5                                                           00730061
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00740061
      I02 = 6                                                           00750061
C     SYSTEM ENVIRONMENT SECTION                                        00760061
C                                                                       00770061
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00780061
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00790061
C     (UNIT NUMBER FOR CARD READER).                                    00800061
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00810061
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00820061
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00830061
C                                                                       00840061
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00850061
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00860061
C     (UNIT NUMBER FOR PRINTER).                                        00870061
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00880061
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00890061
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00900061
C                                                                       00910061
      IVPASS=0                                                          00920061
      IVFAIL=0                                                          00930061
      IVDELE=0                                                          00940061
      ICZERO=0                                                          00950061
C                                                                       00960061
C     WRITE PAGE HEADERS                                                00970061
      WRITE (I02,90000)                                                 00980061
      WRITE (I02,90001)                                                 00990061
      WRITE (I02,90002)                                                 01000061
      WRITE (I02, 90002)                                                01010061
      WRITE (I02,90003)                                                 01020061
      WRITE (I02,90002)                                                 01030061
      WRITE (I02,90004)                                                 01040061
      WRITE (I02,90002)                                                 01050061
      WRITE (I02,90011)                                                 01060061
      WRITE (I02,90002)                                                 01070061
      WRITE (I02,90002)                                                 01080061
      WRITE (I02,90005)                                                 01090061
      WRITE (I02,90006)                                                 01100061
      WRITE (I02,90002)                                                 01110061
C                                                                       01120061
C     TEST SECTION                                                      01130061
C                                                                       01140061
C     TEST 32 THROUGH TEST 42 CONTAIN ARITHMETIC ASSIGNMENT             01150061
C     STATEMENTS OF THE FORM                                            01160061
C                                                                       01170061
C                   INTEGER VARIABLE = REAL VARIABLE                    01180061
C                                                                       01190061
      IVTNUM =  32                                                      01200061
C                                                                       01210061
C      ****  TEST  32  ****                                             01220061
C                                                                       01230061
      IF (ICZERO) 30320,  320, 30320                                    01240061
  320 CONTINUE                                                          01250061
      RVON01 = 44.5                                                     01260061
      IVCOMP = RVON01                                                   01270061
      GO TO 40320                                                       01280061
30320 IVDELE = IVDELE + 1                                               01290061
      WRITE (I02,80003) IVTNUM                                          01300061
      IF (ICZERO) 40320,  331, 40320                                    01310061
40320 IF (IVCOMP - 44) 20320,10320,20320                                01320061
10320 IVPASS = IVPASS + 1                                               01330061
      WRITE (I02,80001) IVTNUM                                          01340061
      GO TO  331                                                        01350061
20320 IVFAIL = IVFAIL + 1                                               01360061
      IVCORR = 44                                                       01370061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01380061
  331 CONTINUE                                                          01390061
      IVTNUM =  33                                                      01400061
C                                                                       01410061
C      ****  TEST  33  ****                                             01420061
C                                                                       01430061
      IF (ICZERO) 30330,  330, 30330                                    01440061
  330 CONTINUE                                                          01450061
      RVON01 = -2.0005                                                  01460061
      IVCOMP = RVON01                                                   01470061
      GO TO 40330                                                       01480061
30330 IVDELE = IVDELE + 1                                               01490061
      WRITE (I02,80003) IVTNUM                                          01500061
      IF (ICZERO) 40330,  341, 40330                                    01510061
40330 IF (IVCOMP + 2) 20330,10330,20330                                 01520061
10330 IVPASS = IVPASS + 1                                               01530061
      WRITE (I02,80001) IVTNUM                                          01540061
      GO TO  341                                                        01550061
20330 IVFAIL = IVFAIL + 1                                               01560061
      IVCORR = -2                                                       01570061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01580061
  341 CONTINUE                                                          01590061
      IVTNUM =  34                                                      01600061
C                                                                       01610061
C      ****  TEST  34  ****                                             01620061
C                                                                       01630061
      IF (ICZERO) 30340,  340, 30340                                    01640061
  340 CONTINUE                                                          01650061
      RVON01 = .32767                                                   01660061
      IVCOMP = RVON01                                                   01670061
      GO TO 40340                                                       01680061
30340 IVDELE = IVDELE + 1                                               01690061
      WRITE (I02,80003) IVTNUM                                          01700061
      IF (ICZERO) 40340,  351, 40340                                    01710061
40340 IF (IVCOMP) 20340,10340,20340                                     01720061
10340 IVPASS = IVPASS + 1                                               01730061
      WRITE (I02,80001) IVTNUM                                          01740061
      GO TO  351                                                        01750061
20340 IVFAIL = IVFAIL + 1                                               01760061
      IVCORR = 0                                                        01770061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01780061
  351 CONTINUE                                                          01790061
      IVTNUM =  35                                                      01800061
C                                                                       01810061
C      ****  TEST  35  ****                                             01820061
C                                                                       01830061
      IF (ICZERO) 30350,  350, 30350                                    01840061
  350 CONTINUE                                                          01850061
      RVON01 = 1.999                                                    01860061
      IVCOMP = RVON01                                                   01870061
      GO TO 40350                                                       01880061
30350 IVDELE = IVDELE + 1                                               01890061
      WRITE (I02,80003) IVTNUM                                          01900061
      IF (ICZERO) 40350,  361, 40350                                    01910061
40350 IF (IVCOMP - 1) 20350,10350,20350                                 01920061
10350 IVPASS = IVPASS + 1                                               01930061
      WRITE (I02,80001) IVTNUM                                          01940061
      GO TO  361                                                        01950061
20350 IVFAIL = IVFAIL + 1                                               01960061
      IVCORR = 1                                                        01970061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01980061
  361 CONTINUE                                                          01990061
      IVTNUM =  36                                                      02000061
C                                                                       02010061
C      ****  TEST  36  ****                                             02020061
C                                                                       02030061
      IF (ICZERO) 30360,  360, 30360                                    02040061
  360 CONTINUE                                                          02050061
      RVON01 = .25E+1                                                   02060061
      IVCOMP = RVON01                                                   02070061
      GO TO 40360                                                       02080061
30360 IVDELE = IVDELE + 1                                               02090061
      WRITE (I02,80003) IVTNUM                                          02100061
      IF (ICZERO) 40360,  371, 40360                                    02110061
40360 IF (IVCOMP - 2) 20360,10360,20360                                 02120061
10360 IVPASS = IVPASS + 1                                               02130061
      WRITE (I02,80001) IVTNUM                                          02140061
      GO TO  371                                                        02150061
20360 IVFAIL = IVFAIL + 1                                               02160061
      IVCORR = 2                                                        02170061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          02180061
  371 CONTINUE                                                          02190061
      IVTNUM =  37                                                      02200061
C                                                                       02210061
C      ****  TEST  37  ****                                             02220061
C                                                                       02230061
      IF (ICZERO) 30370,  370, 30370                                    02240061
  370 CONTINUE                                                          02250061
      RVON01 = 445.0E-01                                                02260061
      IVCOMP = RVON01                                                   02270061
      GO TO 40370                                                       02280061
30370 IVDELE = IVDELE + 1                                               02290061
      WRITE (I02,80003) IVTNUM                                          02300061
      IF (ICZERO) 40370,  381, 40370                                    02310061
40370 IF (IVCOMP - 44) 20370,10370,20370                                02320061
10370 IVPASS = IVPASS + 1                                               02330061
      WRITE (I02,80001) IVTNUM                                          02340061
      GO TO  381                                                        02350061
20370 IVFAIL = IVFAIL + 1                                               02360061
      IVCORR = 44                                                       02370061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          02380061
  381 CONTINUE                                                          02390061
      IVTNUM =  38                                                      02400061
C                                                                       02410061
C      ****  TEST  38  ****                                             02420061
C                                                                       02430061
      IF (ICZERO) 30380,  380, 30380                                    02440061
  380 CONTINUE                                                          02450061
      RVON01 = -651.1E-0                                                02460061
      IVCOMP = RVON01                                                   02470061
      GO TO 40380                                                       02480061
30380 IVDELE = IVDELE + 1                                               02490061
      WRITE (I02,80003) IVTNUM                                          02500061
      IF (ICZERO) 40380,  391, 40380                                    02510061
40380 IF (IVCOMP + 651) 20380,10380,20380                               02520061
10380 IVPASS = IVPASS + 1                                               02530061
      WRITE (I02,80001) IVTNUM                                          02540061
      GO TO  391                                                        02550061
20380 IVFAIL = IVFAIL + 1                                               02560061
      IVCORR = -651                                                     02570061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          02580061
  391 CONTINUE                                                          02590061
      IVTNUM =  39                                                      02600061
C                                                                       02610061
C      ****  TEST  39  ****                                             02620061
C                                                                       02630061
      IF (ICZERO) 30390,  390, 30390                                    02640061
  390 CONTINUE                                                          02650061
      RVON01 = .3266E4                                                  02660061
      IVCOMP = RVON01                                                   02670061
      GO TO 40390                                                       02680061
30390 IVDELE = IVDELE + 1                                               02690061
      WRITE (I02,80003) IVTNUM                                          02700061
      IF (ICZERO) 40390,  401, 40390                                    02710061
40390 IF (IVCOMP - 3266) 20390,10390,20390                              02720061
10390 IVPASS = IVPASS + 1                                               02730061
      WRITE (I02,80001) IVTNUM                                          02740061
      GO TO  401                                                        02750061
20390 IVFAIL = IVFAIL + 1                                               02760061
      IVCORR = 3266                                                     02770061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          02780061
  401 CONTINUE                                                          02790061
      IVTNUM =  40                                                      02800061
C                                                                       02810061
C      ****  TEST  40  ****                                             02820061
C                                                                       02830061
      IF (ICZERO) 30400,  400, 30400                                    02840061
  400 CONTINUE                                                          02850061
      RVON01 = 35.43E-01                                                02860061
      IVCOMP = RVON01                                                   02870061
      GO TO 40400                                                       02880061
30400 IVDELE = IVDELE + 1                                               02890061
      WRITE (I02,80003) IVTNUM                                          02900061
      IF (ICZERO) 40400,  411, 40400                                    02910061
40400 IF (IVCOMP - 3) 20400,10400,20400                                 02920061
10400 IVPASS = IVPASS + 1                                               02930061
      WRITE (I02,80001) IVTNUM                                          02940061
      GO TO  411                                                        02950061
20400 IVFAIL = IVFAIL + 1                                               02960061
      IVCORR = 3                                                        02970061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          02980061
  411 CONTINUE                                                          02990061
      IVTNUM =  41                                                      03000061
C                                                                       03010061
C      ****  TEST  41  ****                                             03020061
C                                                                       03030061
      IF (ICZERO) 30410,  410, 30410                                    03040061
  410 CONTINUE                                                          03050061
      RVON01 = -7.001E2                                                 03060061
      IVCOMP = RVON01                                                   03070061
      GO TO 40410                                                       03080061
30410 IVDELE = IVDELE + 1                                               03090061
      WRITE (I02,80003) IVTNUM                                          03100061
      IF (ICZERO) 40410,  421, 40410                                    03110061
40410 IF (IVCOMP + 700) 20410,10410,20410                               03120061
10410 IVPASS = IVPASS + 1                                               03130061
      WRITE (I02,80001) IVTNUM                                          03140061
      GO TO  421                                                        03150061
20410 IVFAIL = IVFAIL + 1                                               03160061
      IVCORR = -700                                                     03170061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          03180061
  421 CONTINUE                                                          03190061
      IVTNUM =  42                                                      03200061
C                                                                       03210061
C      ****  TEST  42  ****                                             03220061
C                                                                       03230061
      IF (ICZERO) 30420,  420, 30420                                    03240061
  420 CONTINUE                                                          03250061
      RVON01 = 4.45E-02                                                 03260061
      IVCOMP = RVON01                                                   03270061
      GO TO 40420                                                       03280061
30420 IVDELE = IVDELE + 1                                               03290061
      WRITE (I02,80003) IVTNUM                                          03300061
      IF (ICZERO) 40420,  431, 40420                                    03310061
40420 IF (IVCOMP) 20420,10420,20420                                     03320061
10420 IVPASS = IVPASS + 1                                               03330061
      WRITE (I02,80001) IVTNUM                                          03340061
      GO TO  431                                                        03350061
20420 IVFAIL = IVFAIL + 1                                               03360061
      IVCORR = 0                                                        03370061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          03380061
C     TEST 43 THROUGH TEST 48 CONTAIN ARITHMETIC ASSIGNMENT             03390061
C     STATEMENTS OF THE FORM                                            03400061
C                                                                       03410061
C                   REAL VARIABLE = INTEGER VARIABLE                    03420061
C                                                                       03430061
  431 CONTINUE                                                          03440061
      IVTNUM =  43                                                      03450061
C                                                                       03460061
C      ****  TEST  43  ****                                             03470061
C                                                                       03480061
      IF (ICZERO) 30430,  430, 30430                                    03490061
  430 CONTINUE                                                          03500061
      IVON01 = 2                                                        03510061
      RVCOMP = IVON01                                                   03520061
      GO TO 40430                                                       03530061
30430 IVDELE = IVDELE + 1                                               03540061
      WRITE (I02,80003) IVTNUM                                          03550061
      IF (ICZERO) 40430,  441, 40430                                    03560061
40430 IF (RVCOMP - 1.9995) 20430,10430,40431                            03570061
40431 IF (RVCOMP - 2.0005) 10430,10430,20430                            03580061
10430 IVPASS = IVPASS + 1                                               03590061
      WRITE (I02,80001) IVTNUM                                          03600061
      GO TO  441                                                        03610061
20430 IVFAIL = IVFAIL + 1                                               03620061
      RVCORR = 2.0000                                                   03630061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          03640061
  441 CONTINUE                                                          03650061
      IVTNUM =  44                                                      03660061
C                                                                       03670061
C      ****  TEST  44  ****                                             03680061
C                                                                       03690061
      IF (ICZERO) 30440,  440, 30440                                    03700061
  440 CONTINUE                                                          03710061
      IVON01 = 25                                                       03720061
      RVCOMP = IVON01                                                   03730061
      GO TO 40440                                                       03740061
30440 IVDELE = IVDELE + 1                                               03750061
      WRITE (I02,80003) IVTNUM                                          03760061
      IF (ICZERO) 40440,  451, 40440                                    03770061
40440 IF (RVCOMP - 24.995) 20440,10440,40441                            03780061
40441 IF (RVCOMP - 25.005) 10440,10440,20440                            03790061
10440 IVPASS = IVPASS + 1                                               03800061
      WRITE (I02,80001) IVTNUM                                          03810061
      GO TO  451                                                        03820061
20440 IVFAIL = IVFAIL + 1                                               03830061
      RVCORR = 25.000                                                   03840061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          03850061
  451 CONTINUE                                                          03860061
      IVTNUM =  45                                                      03870061
C                                                                       03880061
C      ****  TEST  45  ****                                             03890061
C                                                                       03900061
      IF (ICZERO) 30450,  450, 30450                                    03910061
  450 CONTINUE                                                          03920061
      IVON01 = 357                                                      03930061
      RVCOMP = IVON01                                                   03940061
      GO TO 40450                                                       03950061
30450 IVDELE = IVDELE + 1                                               03960061
      WRITE (I02,80003) IVTNUM                                          03970061
      IF (ICZERO) 40450,  461, 40450                                    03980061
40450 IF (RVCOMP - 356.95) 20450,10450,40451                            03990061
40451 IF (RVCOMP - 357.05) 10450,10450,20450                            04000061
10450 IVPASS = IVPASS + 1                                               04010061
      WRITE (I02,80001) IVTNUM                                          04020061
      GO TO  461                                                        04030061
20450 IVFAIL = IVFAIL + 1                                               04040061
      RVCORR = 357.00                                                   04050061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          04060061
  461 CONTINUE                                                          04070061
      IVTNUM =  46                                                      04080061
C                                                                       04090061
C      ****  TEST  46  ****                                             04100061
C                                                                       04110061
      IF (ICZERO) 30460,  460, 30460                                    04120061
  460 CONTINUE                                                          04130061
      IVON01 = 4968                                                     04140061
      RVCOMP = IVON01                                                   04150061
      GO TO 40460                                                       04160061
30460 IVDELE = IVDELE + 1                                               04170061
      WRITE (I02,80003) IVTNUM                                          04180061
      IF (ICZERO) 40460,  471, 40460                                    04190061
40460 IF (RVCOMP - 4967.5) 20460,10460,40461                            04200061
40461 IF (RVCOMP - 4968.5) 10460,10460,20460                            04210061
10460 IVPASS = IVPASS + 1                                               04220061
      WRITE (I02,80001) IVTNUM                                          04230061
      GO TO  471                                                        04240061
20460 IVFAIL = IVFAIL + 1                                               04250061
      RVCORR = 4968.0                                                   04260061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          04270061
  471 CONTINUE                                                          04280061
      IVTNUM =  47                                                      04290061
C                                                                       04300061
C      ****  TEST  47  ****                                             04310061
C                                                                       04320061
      IF (ICZERO) 30470,  470, 30470                                    04330061
  470 CONTINUE                                                          04340061
      IVON01 = 32767                                                    04350061
      RVCOMP = IVON01                                                   04360061
      GO TO 40470                                                       04370061
30470 IVDELE = IVDELE + 1                                               04380061
      WRITE (I02,80003) IVTNUM                                          04390061
      IF (ICZERO) 40470,  481, 40470                                    04400061
40470 IF (RVCOMP - 32762.) 20470,10470,40471                            04410061
40471 IF (RVCOMP - 32772.) 10470,10470,20470                            04420061
10470 IVPASS = IVPASS + 1                                               04430061
      WRITE (I02,80001) IVTNUM                                          04440061
      GO TO  481                                                        04450061
20470 IVFAIL = IVFAIL + 1                                               04460061
      RVCORR = 32767.                                                   04470061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          04480061
  481 CONTINUE                                                          04490061
      IVTNUM =  48                                                      04500061
C                                                                       04510061
C      ****  TEST  48  ****                                             04520061
C                                                                       04530061
      IF (ICZERO) 30480,  480, 30480                                    04540061
  480 CONTINUE                                                          04550061
      IVON01 = -2                                                       04560061
      RVCOMP = IVON01                                                   04570061
      GO TO 40480                                                       04580061
30480 IVDELE = IVDELE + 1                                               04590061
      WRITE (I02,80003) IVTNUM                                          04600061
      IF (ICZERO) 40480,  491, 40480                                    04610061
40480 IF (RVCOMP + 2.0005) 20480,10480,40481                            04620061
40481 IF (RVCOMP + 1.9995) 10480,10480,20450                            04630061
10480 IVPASS = IVPASS + 1                                               04640061
      WRITE (I02,80001) IVTNUM                                          04650061
      GO TO  491                                                        04660061
20480 IVFAIL = IVFAIL + 1                                               04670061
      RVCORR = -2.0000                                                  04680061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          04690061
C                                                                       04700061
C     TEST 49 THROUGH TEST 51 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS  04710061
C     OF THE FORM                                                       04720061
C                   INTEGER VARIABLE = REAL CONSTANT                    04730061
C     WHERE CONSTANT IS BASIC REAL CONSTANT                             04740061
C                                                                       04750061
  491 CONTINUE                                                          04760061
      IVTNUM =  49                                                      04770061
C                                                                       04780061
C      ****  TEST  49  ****                                             04790061
C                                                                       04800061
      IF (ICZERO) 30490,  490, 30490                                    04810061
  490 CONTINUE                                                          04820061
      IVCOMP = 44.5                                                     04830061
      GO TO 40490                                                       04840061
30490 IVDELE = IVDELE + 1                                               04850061
      WRITE (I02,80003) IVTNUM                                          04860061
      IF (ICZERO) 40490,  501, 40490                                    04870061
40490 IF (IVCOMP - 44) 20490,10490,20490                                04880061
10490 IVPASS = IVPASS + 1                                               04890061
      WRITE (I02,80001) IVTNUM                                          04900061
      GO TO  501                                                        04910061
20490 IVFAIL = IVFAIL + 1                                               04920061
      IVCORR = 44                                                       04930061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          04940061
  501 CONTINUE                                                          04950061
      IVTNUM =  50                                                      04960061
C                                                                       04970061
C      ****  TEST  50  ****                                             04980061
C                                                                       04990061
      IF (ICZERO) 30500,  500, 30500                                    05000061
  500 CONTINUE                                                          05010061
      IVCOMP = 6500.1                                                   05020061
      GO TO 40500                                                       05030061
30500 IVDELE = IVDELE + 1                                               05040061
      WRITE (I02,80003) IVTNUM                                          05050061
      IF (ICZERO) 40500,  511, 40500                                    05060061
40500 IF (IVCOMP - 6500)  20500,10500,20500                             05070061
10500 IVPASS = IVPASS + 1                                               05080061
      WRITE (I02,80001) IVTNUM                                          05090061
      GO TO  511                                                        05100061
20500 IVFAIL = IVFAIL + 1                                               05110061
      IVCORR = 6500                                                     05120061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          05130061
  511 CONTINUE                                                          05140061
      IVTNUM =  51                                                      05150061
C                                                                       05160061
C      ****  TEST  51  ****                                             05170061
C                                                                       05180061
      IF (ICZERO) 30510,  510, 30510                                    05190061
  510 CONTINUE                                                          05200061
      IVCOMP = -.33333                                                  05210061
      GO TO 40510                                                       05220061
30510 IVDELE = IVDELE + 1                                               05230061
      WRITE (I02,80003) IVTNUM                                          05240061
      IF (ICZERO) 40510,  521, 40510                                    05250061
40510 IF (IVCOMP) 20510,10510,20510                                     05260061
10510 IVPASS = IVPASS + 1                                               05270061
      WRITE (I02,80001) IVTNUM                                          05280061
      GO TO  521                                                        05290061
20510 IVFAIL = IVFAIL + 1                                               05300061
      IVCORR = 0                                                        05310061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          05320061
C                                                                       05330061
C     TEST 52 THROUGH TEST 55 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS  05340061
C     OF THE FORM                                                       05350061
C                   INTEGER VARIABLE = REAL CONSTANT                    05360061
C                                                                       05370061
C     WHERE CONSTANT IS BASIC REAL CONSTANT FOLLOWED BY DECIMAL EXPONENT05380061
C                                                                       05390061
  521 CONTINUE                                                          05400061
      IVTNUM =  52                                                      05410061
C                                                                       05420061
C      ****  TEST  52  ****                                             05430061
C                                                                       05440061
      IF (ICZERO) 30520,  520, 30520                                    05450061
  520 CONTINUE                                                          05460061
      IVCOMP = .21E+1                                                   05470061
      GO TO 40520                                                       05480061
30520 IVDELE = IVDELE + 1                                               05490061
      WRITE (I02,80003) IVTNUM                                          05500061
      IF (ICZERO) 40520,  531, 40520                                    05510061
40520 IF (IVCOMP - 2) 20520,10520,20520                                 05520061
10520 IVPASS = IVPASS + 1                                               05530061
      WRITE (I02,80001) IVTNUM                                          05540061
      GO TO  531                                                        05550061
20520 IVFAIL = IVFAIL + 1                                               05560061
      IVCORR = 2                                                        05570061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          05580061
  531 CONTINUE                                                          05590061
      IVTNUM =  53                                                      05600061
C                                                                       05610061
C      ****  TEST  53  ****                                             05620061
C                                                                       05630061
      IF (ICZERO) 30530,  530, 30530                                    05640061
  530 CONTINUE                                                          05650061
      IVCOMP = 445.0E-01                                                05660061
      GO TO 40530                                                       05670061
30530 IVDELE = IVDELE + 1                                               05680061
      WRITE (I02,80003) IVTNUM                                          05690061
      IF (ICZERO) 40530,  541, 40530                                    05700061
40530 IF (IVCOMP - 44) 20530,10530,20530                                05710061
10530 IVPASS = IVPASS + 1                                               05720061
      WRITE (I02,80001) IVTNUM                                          05730061
      GO TO  541                                                        05740061
20530 IVFAIL = IVFAIL + 1                                               05750061
      IVCORR = 44                                                       05760061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          05770061
  541 CONTINUE                                                          05780061
      IVTNUM =  54                                                      05790061
C                                                                       05800061
C      ****  TEST  54  ****                                             05810061
C                                                                       05820061
      IF (ICZERO) 30540,  540, 30540                                    05830061
  540 CONTINUE                                                          05840061
      IVCOMP = 4.450E1                                                  05850061
      GO TO 40540                                                       05860061
30540 IVDELE = IVDELE + 1                                               05870061
      WRITE (I02,80003) IVTNUM                                          05880061
      IF (ICZERO) 40540,  551, 40540                                    05890061
40540 IF (IVCOMP - 44) 20540,10540,20540                                05900061
10540 IVPASS = IVPASS + 1                                               05910061
      WRITE (I02,80001) IVTNUM                                          05920061
      GO TO  551                                                        05930061
20540 IVFAIL = IVFAIL + 1                                               05940061
      IVCORR = 44                                                       05950061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          05960061
  551 CONTINUE                                                          05970061
      IVTNUM =  55                                                      05980061
C                                                                       05990061
C      ****  TEST  55  ****                                             06000061
C                                                                       06010061
      IF (ICZERO) 30550,  550, 30550                                    06020061
  550 CONTINUE                                                          06030061
      IVCOMP = -4.45E0                                                  06040061
      GO TO 40550                                                       06050061
30550 IVDELE = IVDELE + 1                                               06060061
      WRITE (I02,80003) IVTNUM                                          06070061
      IF (ICZERO) 40550,  561, 40550                                    06080061
40550 IF (IVCOMP + 4) 20550,10550,20550                                 06090061
10550 IVPASS = IVPASS + 1                                               06100061
      WRITE (I02,80001) IVTNUM                                          06110061
      GO TO  561                                                        06120061
20550 IVFAIL = IVFAIL + 1                                               06130061
      IVCORR = -4                                                       06140061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          06150061
C                                                                       06160061
C     TEST 56 AND 57 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS OF THE    06170061
C     FORM          INTEGER VARIABLE = REAL CONSTANT                    06180061
C     WHERE CONSTANT IS INTEGER CONSTANT FOLLOWED BY DECIMAL EXPONENT   06190061
C                                                                       06200061
  561 CONTINUE                                                          06210061
      IVTNUM =  56                                                      06220061
C                                                                       06230061
C      ****  TEST  56  ****                                             06240061
C                                                                       06250061
      IF (ICZERO) 30560,  560, 30560                                    06260061
  560 CONTINUE                                                          06270061
      IVCOMP = 445E-02                                                  06280061
      GO TO 40560                                                       06290061
30560 IVDELE = IVDELE + 1                                               06300061
      WRITE (I02,80003) IVTNUM                                          06310061
      IF (ICZERO) 40560,  571, 40560                                    06320061
40560 IF (IVCOMP - 4) 20560,10560,20560                                 06330061
10560 IVPASS = IVPASS + 1                                               06340061
      WRITE (I02,80001) IVTNUM                                          06350061
      GO TO  571                                                        06360061
20560 IVFAIL = IVFAIL + 1                                               06370061
      IVCORR = 4                                                        06380061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          06390061
  571 CONTINUE                                                          06400061
      IVTNUM =  57                                                      06410061
C                                                                       06420061
C      ****  TEST  57  ****                                             06430061
C                                                                       06440061
      IF (ICZERO) 30570,  570, 30570                                    06450061
  570 CONTINUE                                                          06460061
      IVCOMP = -701E-1                                                  06470061
      GO TO 40570                                                       06480061
30570 IVDELE = IVDELE + 1                                               06490061
      WRITE (I02,80003) IVTNUM                                          06500061
      IF (ICZERO) 40570,  581, 40570                                    06510061
40570 IF (IVCOMP + 70) 20570,10570,20570                                06520061
10570 IVPASS = IVPASS + 1                                               06530061
      WRITE (I02,80001) IVTNUM                                          06540061
      GO TO  581                                                        06550061
20570 IVFAIL = IVFAIL + 1                                               06560061
      IVCORR = -70                                                      06570061
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          06580061
C                                                                       06590061
C     TEST 58 THROUGH TEST 62 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS  06600061
C     OF THE FORM   REAL VARIABLE = INTEGER CONSTANT                    06610061
C                                                                       06620061
  581 CONTINUE                                                          06630061
      IVTNUM =  58                                                      06640061
C                                                                       06650061
C      ****  TEST  58  ****                                             06660061
C                                                                       06670061
      IF (ICZERO) 30580,  580, 30580                                    06680061
  580 CONTINUE                                                          06690061
      RVCOMP = 23                                                       06700061
      GO TO 40580                                                       06710061
30580 IVDELE = IVDELE + 1                                               06720061
      WRITE (I02,80003) IVTNUM                                          06730061
      IF (ICZERO) 40580,  591, 40580                                    06740061
40580 IF (RVCOMP - 22.995) 20580,10580,40581                            06750061
40581 IF (RVCOMP - 23.005) 10580,10580,20580                            06760061
10580 IVPASS = IVPASS + 1                                               06770061
      WRITE (I02,80001) IVTNUM                                          06780061
      GO TO  591                                                        06790061
20580 IVFAIL = IVFAIL + 1                                               06800061
      RVCORR = 23.000                                                   06810061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          06820061
  591 CONTINUE                                                          06830061
      IVTNUM =  59                                                      06840061
C                                                                       06850061
C      ****  TEST  59  ****                                             06860061
C                                                                       06870061
      IF (ICZERO) 30590,  590, 30590                                    06880061
  590 CONTINUE                                                          06890061
      RVCOMP = 32645                                                    06900061
      GO TO 40590                                                       06910061
30590 IVDELE = IVDELE + 1                                               06920061
      WRITE (I02,80003) IVTNUM                                          06930061
      IF (ICZERO) 40590,  601, 40590                                    06940061
40590 IF (RVCOMP - 32640.) 20590,10590,40591                            06950061
40591 IF (RVCOMP - 32650.) 10590,10590,20590                            06960061
10590 IVPASS = IVPASS + 1                                               06970061
      WRITE (I02,80001) IVTNUM                                          06980061
      GO TO  601                                                        06990061
20590 IVFAIL = IVFAIL + 1                                               07000061
      RVCORR = 32645.                                                   07010061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          07020061
  601 CONTINUE                                                          07030061
      IVTNUM =  60                                                      07040061
C                                                                       07050061
C      ****  TEST  60  ****                                             07060061
C                                                                       07070061
      IF (ICZERO) 30600,  600, 30600                                    07080061
  600 CONTINUE                                                          07090061
      RVCOMP = 0                                                        07100061
      GO TO 40600                                                       07110061
30600 IVDELE = IVDELE + 1                                               07120061
      WRITE (I02,80003) IVTNUM                                          07130061
      IF (ICZERO) 40600,  611, 40600                                    07140061
40600 IF (RVCOMP) 20600,10600,20600                                     07150061
10600 IVPASS = IVPASS + 1                                               07160061
      WRITE (I02,80001) IVTNUM                                          07170061
      GO TO  611                                                        07180061
20600 IVFAIL = IVFAIL + 1                                               07190061
      RVCORR = 00000.                                                   07200061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          07210061
  611 CONTINUE                                                          07220061
      IVTNUM =  61                                                      07230061
C                                                                       07240061
C      ****  TEST  61  ****                                             07250061
C                                                                       07260061
      IF (ICZERO) 30610,  610, 30610                                    07270061
  610 CONTINUE                                                          07280061
      RVCOMP = -15                                                      07290061
      GO TO 40610                                                       07300061
30610 IVDELE = IVDELE + 1                                               07310061
      WRITE (I02,80003) IVTNUM                                          07320061
      IF (ICZERO) 40610,  621, 40610                                    07330061
40610 IF (RVCOMP -14.995) 40611,10610,20610                             07340061
40611 IF (RVCOMP + 15.005) 20610,10610,10610                            07350061
10610 IVPASS = IVPASS + 1                                               07360061
      WRITE (I02,80001) IVTNUM                                          07370061
      GO TO  621                                                        07380061
20610 IVFAIL = IVFAIL + 1                                               07390061
      RVCORR = -15.000                                                  07400061
      WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR                          07410061
  621 CONTINUE                                                          07420061
C                                                                       07430061
C      ****    END OF TESTS    ****                                     07440061
C                                                                       07450061
C                                                                       07460061
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             07470061
99999 CONTINUE                                                          07480061
      WRITE (I02,90002)                                                 07490061
      WRITE (I02,90006)                                                 07500061
      WRITE (I02,90002)                                                 07510061
      WRITE (I02,90002)                                                 07520061
      WRITE (I02,90007)                                                 07530061
      WRITE (I02,90002)                                                 07540061
      WRITE (I02,90008)  IVFAIL                                         07550061
      WRITE (I02,90009) IVPASS                                          07560061
      WRITE (I02,90010) IVDELE                                          07570061
C                                                                       07580061
C                                                                       07590061
C     TERMINATE ROUTINE EXECUTION                                       07600061
      STOP                                                              07610061
C                                                                       07620061
C     FORMAT STATEMENTS FOR PAGE HEADERS                                07630061
90000 FORMAT ("1")                                                      07640061
90002 FORMAT (" ")                                                      07650061
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            07660061
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   07670061
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        07680061
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07690061
90006 FORMAT (" ",5X,"----------------------------------------------" ) 07700061
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             07710061
C                                                                       07720061
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               07730061
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        07740061
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              07750061
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             07760061
C                                                                       07770061
C     FORMAT STATEMENTS FOR TEST RESULTS                                07780061
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      07790061
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      07800061
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   07810061
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         07820061
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    07830061
C                                                                       07840061
90007 FORMAT (" ",20X,"END OF PROGRAM FM061" )                          07850061
      END                                                               07860061

max_stars_repo_name: MrSidims/llvm-test-suite

max_issues_repo_name: MrSidims/llvm-test-suite

max_forks_repo_name: MrSidims/llvm-test-suite


text:
      subroutine pvswap(q1,q2,m1s,m2s)
      implicit none
      double precision q1(4),q2(4),qtemp(4),m1s,m2s,mtemps
      integer nu
      do nu=1,4
      qtemp(nu)=q1(nu)
      q1(nu)=q2(nu)
      q2(nu)=qtemp(nu)
      enddo
      mtemps=m1s
      m1s=m2s
      m2s=mtemps
      return
      end

ext: f

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


module TrackCellResultModule
  use ParticleLocationListModule,only : ParticleLocationListType
  use ModpathCellDataModule,only : ModpathCellDataType
  implicit none

! Set default access status to private
  private

  type,public :: TrackCellResultType
    integer :: CellNumber
    integer :: ExitFace
    doubleprecision :: MaximumTime
    type(ParticleLocationListType) :: TrackingPoints
    integer :: NextCellNumber
    integer :: Status
    character(len=132) :: LogMessage
  contains
    ! Status enumeration functions
    procedure :: Reset=>pr_Reset
    procedure :: Status_Undefined=>pr_Undefined
    procedure :: Status_ReachedStoppingTime=>pr_ReachedStoppingTime
    procedure :: Status_ExitAtCellFace=>pr_ExitAtCellFace
    procedure :: Status_StopAtWeakSink=>pr_StopAtWeakSink
    procedure :: Status_StopAtWeakSource=>pr_StopAtWeakSource
    procedure :: Status_NoExitPossible=>pr_NoExitPossible
    procedure :: Status_StopZoneCell=>pr_StopZoneCell
    procedure :: Status_InactiveCell=>pr_InactiveCell
    procedure :: Status_InvalidLocation=>pr_InvalidLocation
  end type

contains
! Add procedures here

subroutine pr_Reset(this)
!***************************************************************************************************************
! Description goes here
!***************************************************************************************************************
!
! Specifications
!---------------------------------------------------------------------------------------------------------------
  implicit none
  class(TrackCellResultType) :: this
!---------------------------------------------------------------------------------------------------------------
  this%CellNumber = 0
  this%ExitFace = 0
  this%MaximumTime = 0.0d0
  this%NextCellNumber = 0
  call this%TrackingPoints%Clear()

end subroutine

!-------------------------------------------------------------------
  function pr_Undefined(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 0

  end function pr_Undefined

!-------------------------------------------------------------------
  function pr_ReachedStoppingTime(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 1

  end function pr_ReachedStoppingTime

!-------------------------------------------------------------------
  function pr_ExitAtCellFace(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 2

  end function pr_ExitAtCellFace

!-------------------------------------------------------------------
  function pr_StopAtWeakSink(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 3

  end function pr_StopAtWeakSink

!-------------------------------------------------------------------
  function pr_StopAtWeakSource(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 4

  end function pr_StopAtWeakSource

!-------------------------------------------------------------------
  function pr_NoExitPossible(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 5

  end function pr_NoExitPossible

!-------------------------------------------------------------------
  function pr_StopZoneCell(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 6

  end function pr_StopZoneCell

!-------------------------------------------------------------------
  function pr_InactiveCell(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 7

  end function pr_InactiveCell

!-------------------------------------------------------------------
  function pr_InvalidLocation(this) result(status)
  implicit none
  class(TrackCellResultType) :: this
  integer :: status

  status = 8

  end function pr_InvalidLocation

end module TrackCellResultModule


text:
c
c     version 1.2  Mar 1992
c
c     ----------------------------------------------------------------
c     |                                                              |
c     |            ********   C O M B S E C   ********               |
c     |                                                              |
c     |           Combine two "sect.out" files into one              |
c     |                                                              |
c     |                   Written by C. A. Zelt                      |
c     |                                                              |
c     |                Geological Survey of Canada                   |
c     |                  Ottawa, Canada K1A 0Y3                      |
c     |                                                              |
c     ----------------------------------------------------------------
c
c     Note: the second synthetic section file cannot contain sections
c           corresponding to shots not in the first file. Also, the order
c           of sections within each file must be the same for the those
c           sections whose shots are common to both files.
c
c     I/O units:
c
c        10 -- input:  first synthetic section file
c
c        11 -- input:  second synthetic section file
c
c        12 -- output: combined synthetic section file
c
c     ----------------------------------------------------------------
c
      open(unit=10, file='sect1.in', status='old')
      open(unit=11, file='sect2.in', status='old')
      open(unit=12, file='sect.out')
c
      iflag=2
c
1000  read(10,5,end=990) x1,num1
      if(iflag.eq.2) read(11,5,end=991) x2,num2
5     format(f10.3,i10)
c
1001  if(num1.eq.-1) then
        xshot1=x1
        write(12,5) xshot1,-1
        if(iflag.eq.3) go to 1000
        if(num2.eq.-1) then
          xshot2=x2
        else
          write(6,25)
25        format(/'***  files are not consistent  ***'/)
          stop
        end if
        if(abs(xshot1-xshot2).lt..001) then
          iflag=2
        else
          iflag=1
        end if
        go to 1000
      end if
c
      if(iflag.eq.1.or.iflag.eq.3) then
        write(12,5) x1,num1
      end if
      if(iflag.eq.2) then
        if(abs(x1-x2).gt..001) then
          write(6,25)
          stop
        end if
        write(12,5) x1,num1+num2
      end if
      if(num1.gt.0) then
        do 10 i=1,num1
           read(10,15) s1,s2,s3
15         format(3e12.5)
           write(12,15) s1,s2,s3
10      continue
      end if
      if(iflag.eq.2) then
        if(num2.gt.0) then
          do 20 i=1,num2
             read(11,15) s1,s2,s3
             write(12,15) s1,s2,s3
20        continue
        end if
      end if
      go to 1000
c
991   iflag=3
      go to 1001
c
990   stop
      end


text:
C$Procedure      SCDECD ( Decode spacecraft clock )

      SUBROUTINE SCDECD ( SC, SCLKDP, SCLKCH )

C$ Abstract
C
C     Convert double precision encoding of spacecraft clock time into
C     a character representation.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     SCLK
C
C$ Keywords
C
C     CONVERSION
C     TIME
C
C$ Declarations

      IMPLICIT NONE

      INCLUDE               'sclk.inc'

      INTEGER               SC
      DOUBLE PRECISION      SCLKDP
      CHARACTER*(*)         SCLKCH

C$ Brief_I/O
C
C     Variable  I/O  Description
C     --------  ---  --------------------------------------------------
C     SC         I   NAIF spacecraft identification code.
C     SCLKDP     I   Encoded representation of a spacecraft clock count.
C     SCLKCH     O   Character representation of a clock count.
C     MXPART     P   Maximum number of spacecraft clock partitions.
C
C$ Detailed_Input
C
C     SC         is the NAIF integer code of the spacecraft whose
C                clock's time is being decoded.
C
C     SCLKDP     is the double precision encoding of a clock time in
C                units of ticks since the spacecraft clock start time.
C                This value does reflect partition information.
C
C                An analogy may be drawn between a spacecraft clock
C                and a standard wall clock. The number of ticks
C                corresponding to the wall clock string
C
C                                hh:mm:ss
C
C                would be the number of seconds represented by that
C                time.
C
C                For example:
C
C                      Clock string      Number of ticks
C                      ------------      ---------------
C                        00:00:10              10
C                        00:01:00              60
C                        00:10:00             600
C                        01:00:00            3600
C
C                If SCLKDP contains a fractional part the result
C                is the same as if SCLKDP had been rounded to the
C                nearest whole number.
C
C$ Detailed_Output
C
C     SCLKCH     is the character representation of the clock count.
C                The exact form that SCLKCH takes depends on the
C                spacecraft.
C
C                Nevertheless, SCLKCH will have the following general
C                format:
C
C                             'pp/sclk_string'
C
C                'pp' is an integer greater than or equal to one and
C                represents a "partition number".
C
C                Each mission is divided into some number of partitions.
C                A new partition starts when the spacecraft clock
C                resets, either to zero, or to some other
C                value. Thus, the first partition for any mission
C                starts with launch, and ends with the first clock
C                reset. The second partition starts immediately when
C                the first stopped, and so on.
C
C                In order to be completely unambiguous about a
C                particular time, you need to specify a partition number
C                along with the standard clock string.
C
C                Information about when partitions occur for different
C                missions is contained in a spacecraft clock kernel
C                file which needs to be loaded into the kernel pool
C                before calling SCDECD.
C
C                The routine SCPART may be used to read the partition
C                start and stop times, in encoded units of ticks, from
C                the kernel file.
C
C                Since the end time of one partition is coincident with
C                the begin time of the next, two different time strings
C                with different partition numbers can encode into the
C                same value.
C
C                For example, if partition 1 ends at time t1, and
C                partition 2 starts at time t2, then
C
C                               '1/t1' and '2/t2'
C
C                will be encoded into the same value, say X. SCDECD
C                always decodes such values into the latter of the
C                two partitions. In this example,
C
C                          CALL SCDECD ( X, SC, CLKSTR )
C
C                will result in
C
C                          CLKSTR = '2/t2'.
C
C
C
C                'sclk_string' is a spacecraft specific clock string,
C                typically consisting of a number of components
C                separated by delimiters.
C
C                Using Galileo as an example, the full format is
C
C                               wwwwwwww:xx:y:z
C
C                where z is a mod-8 counter (values 0-7) which
C                increments approximately once every 8 1/3 ms., y is a
C                mod-10 counter (values 0-9) which increments once
C                every time z turns over, i.e., approximately once every
C                66 2/3 ms., xx is a mod-91 (values 0-90) counter
C                which increments once every time y turns over, i.e.,
C                once every 2/3 seconds. wwwwwwww is the Real-Time Image
C                Count (RIM), which increments once every time xx turns
C                over, i.e., once every 60 2/3 seconds. The roll-over
C                expression for the RIM is 16777215, which corresponds
C                to approximately 32 years.
C
C                wwwwwwww, xx, y, and z are referred to interchangeably
C                as the fields or components of the spacecraft clock.
C                SCLK components may be separated by any of these five
C                characters: ' '  ':'  ','  '-'  '.'
C                The delimiter used is determined by a kernel pool
C                variable and can be adjusted by the user.
C
C                Some spacecraft clock components have offset, or
C                starting, values different from zero.  For example,
C                with an offset value of 1, a mod 20 counter would
C                cycle from 1 to 20 instead of from 0 to 19.
C
C                See the SCLK required reading for a detailed
C                description of the Voyager and Mars Observer clock
C                formats.
C
C
C$ Parameters
C
C     MXPART     is the maximum number of spacecraft clock partitions
C                expected in the kernel file for any one spacecraft.
C                See the INCLUDE file sclk.inc for this parameter's
C                value.
C
C$ Exceptions
C
C     1) If kernel variables required by this routine are unavailable,
C        the error will be diagnosed by routines called by this routine.
C        SCLKCH will be returned as a blank string in this case.
C
C     2) If the number of partitions in the kernel file for spacecraft
C        SC exceeds the parameter MXPART, the error
C        'SPICE(TOOMANYPARTS)' is signaled.  SCLKCH will be returned
C        as a blank string in this case.
C
C     3) If the encoded value does not fall in the boundaries of the
C        mission, the error 'SPICE(VALUEOUTOFRANGE)' is signaled.
C        SCLKCH will be returned as a blank string in this case.
C
C     4) If the declared length of SCLKCH is not large enough to
C        contain the output clock string the error
C        'SPICE(SCLKTRUNCATED)' is signaled either by this routine
C        or by a routine called by this routine.  On output SCLKCH
C        will contain a portion of the truncated clock string.
C
C$ Files
C
C     A kernel file containing spacecraft clock partition information
C     for the desired spacecraft must be loaded, using the routine
C     FURNSH, before calling this routine.
C
C$ Particulars
C
C     In general, it is difficult to compare spacecraft clock counts
C     numerically since there are too many clock components for a
C     single comparison.  The routine SCENCD provides a method of
C     assigning a single double precision number to a spacecraft's
C     clock count, given one of its character representations.
C
C     This routine performs the inverse operation to SCENCD, converting
C     an encoded double precision number to character format.
C
C     To convert the number of ticks since the start of the mission to
C     a clock format character string, SCDECD:
C
C        1) Determines the spacecraft clock partition that TICKS falls
C           in.
C
C        2) Subtracts off the number of ticks occurring in previous
C           partitions, to get the number of ticks since the beginning
C           of the current partition.
C
C        3) Converts the resulting ticks to clock format and forms the
C           string
C
C                      'partition_number/clock_string'
C
C
C$ Examples
C
C      Double precision encodings of spacecraft clock counts are used to
C      tag pointing data in the C-kernel.
C
C      In the following example, pointing for a sequence of images from
C      the Voyager 2 narrow angle camera is requested from the C-kernel
C      using an array of character spacecraft clock counts as input.
C      The clock counts attached to the output are then decoded to
C      character and compared with the input strings.
C
C            CHARACTER*(25)     CLKIN   ( 4 )
C            CHARACTER*(25)     CLKOUT
C            CHARACTER*(25)     CLKTOL
C
C            DOUBLE PRECISION   TIMEIN
C            DOUBLE PRECISION   TIMOUT
C            DOUBLE PRECISION   CMAT     ( 3, 3 )
C
C            INTEGER            NPICS
C            INTEGER            SC
C
C            DATA  NPICS     /  4                   /
C
C            DATA  CLKIN     / '2/20538:39:768',
C           .                  '2/20543:21:768',
C           .                  '2/20550:37',
C           .                  '2/20561:59'         /
C
C            DATA  CLKTOL   /  '      0:01:000'     /
C
C      C
C      C     The instrument we want pointing for is the Voyager 2
C      C     narrow angle camera.  The reference frame we want is
C      C     J2000. The spacecraft is Voyager 2.
C      C
C            INST = -32001
C            REF  = 'J2000'
C            SC   = -32
C
C      C
C      C     Load the appropriate files. We need
C      C
C      C     1) CK file containing pointing data.
C      C     2) Spacecraft clock kernel file, for SCENCD and SCDECD.
C      C
C            CALL CKLPF  ( 'VGR2NA.CK' )
C            CALL FURNSH ( 'SCLK.KER'  )
C
C      C
C      C     Convert the tolerance string to ticks.
C      C
C            CALL SCTIKS ( SC, CLKTOL, TOL )
C
C            DO I = 1, NPICS
C
C               CALL SCENCD ( SC, CLKIN( I ), TIMEIN )
C
C               CALL CKGP   ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT,
C           .                 FOUND )
C
C               CALL SCDECD ( SC, TIMOUT, CLKOUT )
C
C               WRITE (*,*)
C               WRITE (*,*) 'Input  s/c clock count: ', CLKIN( I )
C               WRITE (*,*) 'Output s/c clock count: ', CLKOUT
C               WRITE (*,*) 'Output C-Matrix:        ', CMAT
C
C            END DO
C
C
C     The output from such a program might look like:
C
C
C            Input  s/c clock count:  2/20538:39:768
C            Output s/c clock count:  2/20538:39:768
C            Output C-Matrix:  'first C-matrix'
C
C            Input  s/c clock count:  2/20543:21:768
C            Output s/c clock count:  2/20543:22:768
C            Output C-Matrix:  'second C-matrix'
C
C            Input  s/c clock count:  2/20550:37
C            Output s/c clock count:  2/20550:36:768
C            Output C-Matrix:  'third C-matrix'
C
C            Input  s/c clock count:  2/20561:59
C            Output s/c clock count:  2/20561:58:768
C            Output C-Matrix:  'fourth C-matrix'
C
C
C$ Restrictions
C
C     1) Assumes that an SCLK kernel file appropriate for the clock
C        designated by SC is loaded in the kernel pool at the time
C        this routine is called.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     N.J. Bachman (JPL)
C     J.M. Lynch   (JPL)
C     R.E. Thurman (JPL)
C
C$ Version
C
C-    SPICELIB Version 2.1.0, 05-FEB-2008 (NJB)
C
C        Values of parameter MXPART and PARTLN are now
C        provided by the INCLUDE file sclk.inc.
C
C-    SPICELIB Version 2.0.1, 22-AUG-2006 (EDW)
C
C        Replaced references to LDPOOL with references
C        to FURNSH.
C
C-    SPICELIB Version 2.0.0, 17-APR-1992 (JML) (WLT)
C
C        The routine was changed to signal an error when SCLKCH is
C        not long enough to contain the output spacecraft clock
C        string.
C
C        FAILED is now checked after calling SCPART.
C
C        References to CLPOOL were deleted.
C
C        Miscellaneous minor updates to the header were performed.
C
C        Comment section for permuted index source lines was added
C        following the header.
C
C-    SPICELIB Version 1.0.0, 06-SEP-1990 (JML) (RET)
C
C-&

C$ Index_Entries
C
C     decode spacecraft_clock
C
C-&

C$ Revisions
C
C-    SPICELIB Version 2.0.0, 10-APR-1992 (JML) (WLT)
C
C        The routine was changed to signal an error when SCLKCH is
C        not long enough to contain the output spacecraft clock
C        string.  Previously, the SCLK routines simply truncated
C        the clock string on the right.  It was determined that
C        since this truncation could easily go undetected by the
C        user ( only the leftmost field of a clock string is
C        required when clock string is used as an input to a
C        SCLK routine ), it would be better to signal an error
C        when this happens.
C
C        FAILED is checked after calling SCPART in case an
C        error has occurred reading the kernel file and the
C        error action is not set to 'abort'.
C
C        References to CLPOOL were deleted.
C
C        Miscellaneous minor updates to the header were performed.
C
C        Comment section for permuted index source lines was added
C        following the header.
C
C-&

C
C     SPICELIB functions
C
      LOGICAL               RETURN
      LOGICAL               FAILED

      INTEGER               LSTLED
      INTEGER               LASTNB

C
C     Local variables
C
      CHARACTER*(PARTLN)    PRTSTR

      INTEGER               NPARTS
      INTEGER               PART
      INTEGER               PRELEN
      INTEGER               SUFLEN
      INTEGER               I

      DOUBLE PRECISION      TICKS
      DOUBLE PRECISION      PSTART   ( MXPART )
      DOUBLE PRECISION      PSTOP    ( MXPART )
      DOUBLE PRECISION      PTOTLS   ( MXPART )

C
C     Standard SPICE error handling.
C
      IF ( RETURN () ) THEN
         RETURN
      ELSE
         CALL CHKIN ( 'SCDECD' )
      END IF

C
C     Use a working copy of the input.
C
      TICKS = ANINT ( SCLKDP )

      SCLKCH = ' '

C
C     Read the partition start and stop times (in ticks) for this
C     mission. Error if there are too many of them.  Also need to
C     check FAILED in case error handling is not in ABORT or
C     DEFAULT mode.
C
      CALL SCPART ( SC, NPARTS, PSTART, PSTOP )

      IF ( FAILED() ) THEN
         CALL CHKOUT ( 'SCDECD' )
         RETURN
      END IF

      IF ( NPARTS .GT. MXPART ) THEN

         CALL SETMSG ( 'The number of partitions, #, for spacecraft ' //
     .                 '# exceeds the value for parameter MXPART, #.' )
         CALL ERRINT ( '#', NPARTS           )
         CALL ERRINT ( '#', SC               )
         CALL ERRINT ( '#', MXPART           )
         CALL SIGERR ( 'SPICE(TOOMANYPARTS)' )
         CALL CHKOUT ( 'SCDECD'              )
         RETURN

      END IF

C
C     For each partition, compute the total number of ticks in that
C     partition plus all preceding partitions.
C
      PTOTLS( 1 ) = ANINT ( PSTOP( 1 ) - PSTART( 1 ) )

      DO I = 2, NPARTS
         PTOTLS( I ) = ANINT ( PTOTLS( I-1 ) + PSTOP( I ) - PSTART( I ))
      END DO

C
C     The partition corresponding to the input ticks is the first one
C     whose tick total is greater than the input value.  The one
C     exception is when the input ticks is equal to the total number
C     of ticks represented by all the partitions.  In this case the
C     partition number is the last one, i.e. NPARTS.
C
C     Error if TICKS comes before the first partition (that is, if it's
C     negative), or after the last one.
C

      IF ( TICKS .EQ. PTOTLS (NPARTS) )  THEN
         PART = NPARTS
      ELSE
         PART = LSTLED ( TICKS, NPARTS, PTOTLS ) + 1
      END IF

      IF ( ( TICKS .LT. 0.D0 ).OR.( PART .GT. NPARTS ) ) THEN

         CALL SETMSG ( 'Value for ticks, #, does not fall in any ' //
     .                 'partition for spacecraft #.'  )
         CALL ERRDP  ( '#', TICKS                     )
         CALL ERRINT ( '#', SC                        )
         CALL SIGERR ( 'SPICE(VALUEOUTOFRANGE)'       )
         CALL CHKOUT ( 'SCDECD'                       )
         RETURN

      END IF

C
C     To get the count in this partition, subtract off the total of
C     the preceding partition counts and add the beginning count for
C     this partition.
C
      IF ( PART .EQ. 1 ) THEN
         TICKS = TICKS + PSTART( PART )
      ELSE
         TICKS = TICKS + PSTART( PART ) - PTOTLS( PART - 1 )
      END IF

C
C     Now create the output SCLK clock string.
C
C     First convert from ticks to clock string format.
C
      CALL SCFMT (  SC, TICKS, SCLKCH )

C
C     Now convert the partition number to a character string and prefix
C     it to the output string.
C
      CALL INTSTR ( PART, PRTSTR )

      CALL SUFFIX ( '/', 0, PRTSTR )

      PRELEN = LASTNB ( PRTSTR )
      SUFLEN = LASTNB ( SCLKCH )

      IF ( LEN ( SCLKCH ) - SUFLEN .LT. PRELEN ) THEN

         CALL SETMSG ( 'Output string too short to contain clock '    //
     .                 'string. Input tick value: #, requires string '//
     .                 'of length #, but declared length is #.'       )
         CALL ERRDP  ( '#', SCLKDP )
         CALL ERRINT ( '#', PRELEN + SUFLEN     )
         CALL ERRINT ( '#', LEN ( SCLKCH )      )
         CALL SIGERR ( 'SPICE(SCLKTRUNCATED)'   )
         CALL CHKOUT ( 'SCDECD'                 )
         RETURN

      END IF

      CALL PREFIX ( PRTSTR, 0, SCLKCH )

      CALL CHKOUT ( 'SCDECD' )
      RETURN
      END

max_stars_repo_name: agforero/FTFramework

max_issues_repo_name: agforero/fortran-testing-framework

max_forks_repo_name: agforero/fortran-testing-framework


text:
C -*- Mode: Fortran; -*-
C
C  (C) 2003 by Argonne National Laboratory.
C      See COPYRIGHT in top-level directory.
C
      program main
      implicit none
      include 'mpif.h'
      integer value, wsize, wrank, extra, mykey
      integer rvalue, svalue, ncomm
      logical flag
      integer ierr, errs
C
      errs = 0
      call mtest_init( ierr )
      call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
      call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
C
C     Simple attribute put and get
C
      call mpi_keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN,
     $     mykey, extra,ierr )
      call mpi_attr_get( MPI_COMM_WORLD, mykey, value, flag, ierr )
      if (flag) then
         errs = errs + 1
         print *,
     $       "Did not get flag==.false. for attribute that was not set"
      endif
C
      value = 1234567
      svalue = value
      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
      value = -9876543
      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
      if (.not. flag) then
         errs = errs + 1
         print *, "Did not find attribute after set"
      else
         if (rvalue .ne. svalue) then
            errs = errs + 1
            print *, "Attribute value ", rvalue, " should be ", svalue
         endif
      endif
      value = -123456
      svalue = value
      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
      value = 987654
      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
      if (.not. flag) then
         errs = errs + 1
         print *, "Did not find attribute after set (neg)"
      else
         if (rvalue .ne. svalue) then
            errs = errs + 1
            print *, "Neg Attribute value ", rvalue," should be ",svalue
         endif
      endif
C
      call mpi_keyval_free( mykey, ierr )
      call mtest_finalize( errs )
      end

max_stars_repo_name: ucd-plse/mpi-error-prop

max_issues_repo_name: ucd-plse/mpi-error-prop

max_forks_repo_name: ucd-plse/mpi-error-prop