      PROGRAM FM354

C***********************************************************************00010354
C*****  FORTRAN 77                                                      00020354
C*****   FM354              XREAL - (152)                               00030354
C*****                                                                  00040354
C***********************************************************************00050354
C*****  GENERAL PURPOSE                                       SUBSET REF00060354
C*****    TEST INTRINSIC FUNCTIONS FLOAT AND REAL                15.3   00070354
C*****    (CONVERSION FROM INTEGER TO REAL)                    (TABLE 5)00080354
C*****                                                                  00090354
CBB** ********************** BBCCOMNT **********************************00100354
C****                                                                   00110354
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120354
C****                          VERSION 2.1                              00130354
C****                                                                   00140354
C****                                                                   00150354
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160354
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00170354
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00180354
C****                      BUILDING 225  RM A266                        00190354
C****                     GAITHERSBURG, MD  20899                       00200354
C****                                                                   00210354
C****                                                                   00220354
C****                                                                   00230354
CBE** ********************** BBCCOMNT **********************************00240354
CBB** ********************** BBCINITA **********************************00250354
C**** SPECIFICATION STATEMENTS                                          00260354
C****                                                                   00270354
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00280354
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00290354
CBE** ********************** BBCINITA **********************************00300354
CBB** ********************** BBCINITB **********************************00310354
C**** INITIALIZE SECTION                                                00320354
      DATA  ZVERS,                  ZVERSD,             ZDATE           00330354
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00340354
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00350354
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00360354
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00370354
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00380354
      DATA   REMRKS /'                               '/                 00390354
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00400354
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00410354
C****                                                                   00420354
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00430354
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00440354
CZ03  ZPROG  = 'PROGRAM NAME'                                           00450354
CZ04  ZDATE  = 'DATE OF TEST'                                           00460354
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00470354
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00480354
CZ07  ZNAME  = 'NAME OF USER'                                           00490354
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00500354
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00510354
C                                                                       00520354
      IVPASS = 0                                                        00530354
      IVFAIL = 0                                                        00540354
      IVDELE = 0                                                        00550354
      IVINSP = 0                                                        00560354
      IVTOTL = 0                                                        00570354
      IVTOTN = 0                                                        00580354
      ICZERO = 0                                                        00590354
C                                                                       00600354
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00610354
      I01 = 05                                                          00620354
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00630354
      I02 = 06                                                          00640354
C                                                                       00650354
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660354
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00670354
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00680354
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00690354
C                                                                       00700354
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00710354
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00720354
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00730354
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00740354
C                                                                       00750354
CBE** ********************** BBCINITB **********************************00760354
      NUVI = I02                                                        00770354
      IVTOTL = 14                                                       00780354
      ZPROG = 'FM354'                                                   00790354
CBB** ********************** BBCHED0A **********************************00800354
C****                                                                   00810354
C**** WRITE REPORT TITLE                                                00820354
C****                                                                   00830354
      WRITE (I02, 90002)                                                00840354
      WRITE (I02, 90006)                                                00850354
      WRITE (I02, 90007)                                                00860354
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00870354
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00880354
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00890354
CBE** ********************** BBCHED0A **********************************00900354
C*****                                                                  00910354
C*****    HEADER FOR SEGMENT 152                                        00920354
        WRITE (NUVI,15201)                                              00930354
15201   FORMAT (" ", // 2X,"XREAL - (152) INTRINSIC FUNCTIONS--" //17X, 00940354
     1      "FLOAT, REAL (TYPE CONVERSION)" // 2X,                      00950354
     2      "SUBSET REF. - 15.3" )                                      00960354
CBB** ********************** BBCHED0B **********************************00970354
C**** WRITE DETAIL REPORT HEADERS                                       00980354
C****                                                                   00990354
      WRITE (I02,90004)                                                 01000354
      WRITE (I02,90004)                                                 01010354
      WRITE (I02,90013)                                                 01020354
      WRITE (I02,90014)                                                 01030354
      WRITE (I02,90015) IVTOTL                                          01040354
CBE** ********************** BBCHED0B **********************************01050354
C*****                                                                  01060354
C*****    TEST OF FLOAT                                                 01070354
C*****                                                                  01080354
        WRITE(NUVI, 15204)                                              01090354
15204   FORMAT (/ 8X, "TEST OF FLOAT" )                                 01100354
CT001*  TEST 1                                           THE VALUE ZERO 01110354
           IVTNUM = 1                                                   01120354
        IBCVI = 0                                                       01130354
        RBAVS = FLOAT(IBCVI)                                            01140354
           IF (RBAVS + 0.00005) 20010, 10010, 40010                     01150354
40010      IF (RBAVS - 0.00005) 10010, 10010, 20010                     01160354
10010      IVPASS = IVPASS + 1                                          01170354
           WRITE (NUVI, 80002) IVTNUM                                   01180354
           GO TO 0011                                                   01190354
20010      IVFAIL = IVFAIL + 1                                          01200354
           RVCORR = 0.0                                                 01210354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01220354
 0011      CONTINUE                                                     01230354
CT002*  TEST 2                                       A POSITIVE INTEGER 01240354
           IVTNUM = 2                                                   01250354
        IBCVI = 3                                                       01260354
        RBAVS = FLOAT(IBCVI)                                            01270354
           IF (RBAVS - 2.9998) 20020, 10020, 40020                      01280354
40020      IF (RBAVS - 3.0002) 10020, 10020, 20020                      01290354
10020      IVPASS = IVPASS + 1                                          01300354
           WRITE (NUVI, 80002) IVTNUM                                   01310354
           GO TO 0021                                                   01320354
20020      IVFAIL = IVFAIL + 1                                          01330354
           RVCORR = 3.0                                                 01340354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01350354
 0021      CONTINUE                                                     01360354
CT003*  TEST 3                                       A NEGATIVE INTEGER 01370354
           IVTNUM = 3                                                   01380354
        IBCVI = -3                                                      01390354
        RBAVS = FLOAT(IBCVI)                                            01400354
           IF (RBAVS + 3.0002) 20030, 10030, 40030                      01410354
40030      IF (RBAVS + 2.9998) 10030, 10030, 20030                      01420354
10030      IVPASS = IVPASS + 1                                          01430354
           WRITE (NUVI, 80002) IVTNUM                                   01440354
           GO TO 0031                                                   01450354
20030      IVFAIL = IVFAIL + 1                                          01460354
           RVCORR = -3.0                                                01470354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01480354
 0031      CONTINUE                                                     01490354
CT004*  TEST 4                        A ZERO PREFIXED WITH A MINUS SIGN 01500354
           IVTNUM = 4                                                   01510354
        IBCVI = 0                                                       01520354
        RBAVS = FLOAT(-IBCVI)                                           01530354
           IF (RBAVS + 0.00005) 20040, 10040, 40040                     01540354
40040      IF (RBAVS - 0.00005) 10040, 10040, 20040                     01550354
10040      IVPASS = IVPASS + 1                                          01560354
           WRITE (NUVI, 80002) IVTNUM                                   01570354
           GO TO 0041                                                   01580354
20040      IVFAIL = IVFAIL + 1                                          01590354
           RVCORR = 0.0                                                 01600354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01610354
 0041      CONTINUE                                                     01620354
CT005*  TEST 5                   FLOAT USED IN AN ARITHMETIC EXPRESSION 01630354
           IVTNUM = 5                                                   01640354
        RBFVS = -3.0                                                    01650354
        IBCVI = 3                                                       01660354
        RBAVS = 16.1875 + RBFVS/FLOAT(IBCVI)                            01670354
           IF (RBAVS - 15.186) 20050, 10050, 40050                      01680354
40050      IF (RBAVS - 15.189) 10050, 10050, 20050                      01690354
10050      IVPASS = IVPASS + 1                                          01700354
           WRITE (NUVI, 80002) IVTNUM                                   01710354
           GO TO 0051                                                   01720354
20050      IVFAIL = IVFAIL + 1                                          01730354
           RVCORR = 15.1875                                             01740354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01750354
 0051      CONTINUE                                                     01760354
CT006*  TEST 6              AN ARITHMETIC EXPRESSION PRESENTED TO FLOAT 01770354
           IVTNUM = 6                                                   01780354
        IBAVI = -7                                                      01790354
        IBBVI = 27                                                      01800354
        RBAVS = FLOAT(IBAVI - IBBVI * 2)                                01810354
           IF (RBAVS + 61.003) 20060, 10060, 40060                      01820354
40060      IF (RBAVS + 60.997) 10060, 10060, 20060                      01830354
10060      IVPASS = IVPASS + 1                                          01840354
           WRITE (NUVI, 80002) IVTNUM                                   01850354
           GO TO 0061                                                   01860354
20060      IVFAIL = IVFAIL + 1                                          01870354
           RVCORR = -61.0                                               01880354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     01890354
 0061      CONTINUE                                                     01900354
CT007*  TEST 7            COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 01910354
           IVTNUM = 7                                                   01920354
        IBAVI = 2                                                       01930354
        IBBVI = 10                                                      01940354
        RBAVS = FLOAT(IBBVI ** IBAVI)                                   01950354
           IF (RBAVS - 99.995) 20070, 10070, 40070                      01960354
40070      IF (RBAVS - 100.01) 10070, 10070, 20070                      01970354
10070      IVPASS = IVPASS + 1                                          01980354
           WRITE (NUVI, 80002) IVTNUM                                   01990354
           GO TO 0071                                                   02000354
20070      IVFAIL = IVFAIL + 1                                          02010354
           RVCORR = 100.0                                               02020354
           WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR                     02030354
 0071      CONTINUE                                                     02040354
C*****                                                                  02050354
C*****    TEST OF REAL                                                  02060354
C*****                                                                  02070354
        WRITE(NUVI, 15202)                                              02080354
15202   FORMAT (/ 08X, "TEST OF REAL" )                                 02090354
CT008*  TEST 8                                           THE VALUE ZERO 02100354
           IVTNUM = 8                                                   02110354
        IBCVI = 0                                                       02120354
        RBBVS = REAL(IBCVI)                                             02130354
           IF (RBBVS + 0.00005) 20080, 10080, 40080                     02140354
40080      IF (RBBVS - 0.00005) 10080, 10080, 20080                     02150354
10080      IVPASS = IVPASS + 1                                          02160354
           WRITE (NUVI, 80002) IVTNUM                                   02170354
           GO TO 0081                                                   02180354
20080      IVFAIL = IVFAIL + 1                                          02190354
           RVCORR = 0.0                                                 02200354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02210354
 0081      CONTINUE                                                     02220354
CT009*  TEST 9                                       A POSITIVE INTEGER 02230354
           IVTNUM = 9                                                   02240354
        IBCVI = 3                                                       02250354
        RBBVS = REAL(IBCVI)                                             02260354
           IF (RBBVS - 2.9998) 20090, 10090, 40090                      02270354
40090      IF (RBBVS - 3.0002) 10090, 10090, 20090                      02280354
10090      IVPASS = IVPASS + 1                                          02290354
           WRITE (NUVI, 80002) IVTNUM                                   02300354
           GO TO 0091                                                   02310354
20090      IVFAIL = IVFAIL + 1                                          02320354
           RVCORR = 3.0                                                 02330354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02340354
 0091      CONTINUE                                                     02350354
CT010*  TEST 10                                      A NEGATIVE INTEGER 02360354
           IVTNUM = 10                                                  02370354
        IBCVI = -3                                                      02380354
        RBBVS = REAL(IBCVI)                                             02390354
           IF (RBBVS + 3.0002) 20100, 10100, 40100                      02400354
40100      IF (RBBVS + 2.9998) 10100, 10100, 20100                      02410354
10100      IVPASS = IVPASS + 1                                          02420354
           WRITE (NUVI, 80002) IVTNUM                                   02430354
           GO TO 0101                                                   02440354
20100      IVFAIL = IVFAIL + 1                                          02450354
           RVCORR = -3.0                                                02460354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02470354
 0101      CONTINUE                                                     02480354
CT011*  TEST 11                       A ZERO PREFIXED WITH A MINUS SIGN 02490354
           IVTNUM = 11                                                  02500354
        IBCVI = 0                                                       02510354
        RBBVS = REAL(-IBCVI)                                            02520354
           IF (RBBVS + 0.00005) 20110, 10110, 40110                     02530354
40110      IF (RBBVS - 0.00005) 10110, 10110, 20110                     02540354
10110      IVPASS = IVPASS + 1                                          02550354
           WRITE (NUVI, 80002) IVTNUM                                   02560354
           GO TO 0111                                                   02570354
20110      IVFAIL = IVFAIL + 1                                          02580354
           RVCORR = 0.0                                                 02590354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02600354
 0111      CONTINUE                                                     02610354
CT012*  TEST 12                   REAL USED IN AN ARITHMETIC EXPRESSION 02620354
           IVTNUM = 12                                                  02630354
        RBFVS = -3.0                                                    02640354
        IBCVI = 3                                                       02650354
        RBBVS = 16.1875 + RBFVS/REAL(IBCVI)                             02660354
           IF (RBBVS - 15.186) 20120, 10120, 40120                      02670354
40120      IF (RBBVS - 15.189) 10120, 10120, 20120                      02680354
10120      IVPASS = IVPASS + 1                                          02690354
           WRITE (NUVI, 80002) IVTNUM                                   02700354
           GO TO 0121                                                   02710354
20120      IVFAIL = IVFAIL + 1                                          02720354
           RVCORR = 15.1875                                             02730354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02740354
 0121      CONTINUE                                                     02750354
CT013*  TEST 13              AN ARITHMETIC EXPRESSION PRESENTED TO REAL 02760354
           IVTNUM = 13                                                  02770354
        IBAVI = -7                                                      02780354
        IBBVI = 27                                                      02790354
        RBBVS = REAL(IBAVI - IBBVI * 2)                                 02800354
           IF (RBBVS + 61.003) 20130, 10130, 40130                      02810354
40130      IF (RBBVS + 60.997) 10130, 10130, 20130                      02820354
10130      IVPASS = IVPASS + 1                                          02830354
           WRITE (NUVI, 80002) IVTNUM                                   02840354
           GO TO 0131                                                   02850354
20130      IVFAIL = IVFAIL + 1                                          02860354
           RVCORR = 61.0                                                02870354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     02880354
 0131      CONTINUE                                                     02890354
CT014*  TEST 14           COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02900354
           IVTNUM = 14                                                  02910354
        IBAVI = 2                                                       02920354
        IBBVI = 10                                                      02930354
        RBBVS = REAL(IBBVI ** IBAVI)                                    02940354
           IF (RBBVS - 99.995) 20140, 10140, 40140                      02950354
40140      IF (RBBVS - 100.01) 10140, 10140, 20140                      02960354
10140      IVPASS = IVPASS + 1                                          02970354
           WRITE (NUVI, 80002) IVTNUM                                   02980354
           GO TO 0141                                                   02990354
20140      IVFAIL = IVFAIL + 1                                          03000354
           RVCORR = 100.0                                               03010354
           WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR                     03020354
 0141      CONTINUE                                                     03030354
CBB** ********************** BBCSUM0  **********************************03040354
C**** WRITE OUT TEST SUMMARY                                            03050354
C****                                                                   03060354
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        03070354
      WRITE (I02, 90004)                                                03080354
      WRITE (I02, 90014)                                                03090354
      WRITE (I02, 90004)                                                03100354
      WRITE (I02, 90020) IVPASS                                         03110354
      WRITE (I02, 90022) IVFAIL                                         03120354
      WRITE (I02, 90024) IVDELE                                         03130354
      WRITE (I02, 90026) IVINSP                                         03140354
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 03150354
CBE** ********************** BBCSUM0  **********************************03160354
CBB** ********************** BBCFOOT0 **********************************03170354
C**** WRITE OUT REPORT FOOTINGS                                         03180354
C****                                                                   03190354
      WRITE (I02,90016) ZPROG, ZPROG                                    03200354
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     03210354
      WRITE (I02,90019)                                                 03220354
CBE** ********************** BBCFOOT0 **********************************03230354
CBB** ********************** BBCFMT0A **********************************03240354
C**** FORMATS FOR TEST DETAIL LINES                                     03250354
C****                                                                   03260354
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           03270354
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           03280354
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           03290354
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           03300354
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           03310354
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    03320354
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03330354
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              03340354
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03350354
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  03360354
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         03370354
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         03380354
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         03390354
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         03400354
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      03410354
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      03420354
80050 FORMAT (" ",48X,A31)                                              03430354
CBE** ********************** BBCFMT0A **********************************03440354
CBB** ********************** BBCFMT0B **********************************03450354
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03460354
C****                                                                   03470354
90002 FORMAT ("1")                                                      03480354
90004 FORMAT (" ")                                                      03490354
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03500354
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03510354
90008 FORMAT (" ",21X,A13,A17)                                          03520354
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03530354
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03540354
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03550354
     1       7X,"REMARKS",24X)                                          03560354
90014 FORMAT (" ","----------------------------------------------" ,    03570354
     1        "---------------------------------" )                     03580354
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03590354
C****                                                                   03600354
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03610354
C****                                                                   03620354
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03630354
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03640354
     1        A13)                                                      03650354
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03660354
C****                                                                   03670354
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03680354
C****                                                                   03690354
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03700354
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03710354
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03720354
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03730354
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03740354
CBE** ********************** BBCFMT0B **********************************03750354
C*****                                                                  03760354
C*****    END OF TEST SEGMENT 152                                       03770354
        STOP                                                            03780354
        END                                                             03790354
                                                                        03800354