      PROGRAM FM803

C***********************************************************************00010803
C*****  FORTRAN 77                                                      00020803
C*****   FM803               YCABS - (158)                              00030803
C*****                                                                  00040803
C***********************************************************************00050803
C*****  GENERAL PURPOSE                                         ANS REF 00060803
C*****    TEST INTRINSIC FUNCTION CABS (ABSOLUTE VALUE OF        15.3   00070803
C*****    A COMPLEX ARGUMENT)                                  (TABLE 5)00080803
C*****                                                                  00090803
CBB** ********************** BBCCOMNT **********************************00100803
C****                                                                   00110803
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120803
C****                          VERSION 2.1                              00130803
C****                                                                   00140803
C****                                                                   00150803
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160803
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00170803
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00180803
C****                      BUILDING 225  RM A266                        00190803
C****                     GAITHERSBURG, MD  20899                       00200803
C****                                                                   00210803
C****                                                                   00220803
C****                                                                   00230803
CBE** ********************** BBCCOMNT **********************************00240803
C*****                                                                  00250803
C*****    S P E C I F I C A T I O N S  SEGMENT 158                      00260803
        COMPLEX CPAVC                                                   00270803
C*****                                                                  00280803
CBB** ********************** BBCINITA **********************************00290803
C**** SPECIFICATION STATEMENTS                                          00300803
C****                                                                   00310803
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00320803
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00330803
CBE** ********************** BBCINITA **********************************00340803
CBB** ********************** BBCINITB **********************************00350803
C**** INITIALIZE SECTION                                                00360803
      DATA  ZVERS,                  ZVERSD,             ZDATE           00370803
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00380803
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00390803
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00400803
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00410803
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00420803
      DATA   REMRKS /'                               '/                 00430803
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00440803
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00450803
C****                                                                   00460803
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00470803
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00480803
CZ03  ZPROG  = 'PROGRAM NAME'                                           00490803
CZ04  ZDATE  = 'DATE OF TEST'                                           00500803
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00510803
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00520803
CZ07  ZNAME  = 'NAME OF USER'                                           00530803
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00540803
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00550803
C                                                                       00560803
      IVPASS = 0                                                        00570803
      IVFAIL = 0                                                        00580803
      IVDELE = 0                                                        00590803
      IVINSP = 0                                                        00600803
      IVTOTL = 0                                                        00610803
      IVTOTN = 0                                                        00620803
      ICZERO = 0                                                        00630803
C                                                                       00640803
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00650803
      I01 = 05                                                          00660803
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00670803
      I02 = 06                                                          00680803
C                                                                       00690803
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700803
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00710803
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00720803
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00730803
C                                                                       00740803
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00750803
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00760803
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00770803
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00780803
C                                                                       00790803
CBE** ********************** BBCINITB **********************************00800803
      NUVI = I02                                                        00810803
      IVTOTL = 9                                                        00820803
      ZPROG = 'FM803'                                                   00830803
CBB** ********************** BBCHED0A **********************************00840803
C****                                                                   00850803
C**** WRITE REPORT TITLE                                                00860803
C****                                                                   00870803
      WRITE (I02, 90002)                                                00880803
      WRITE (I02, 90006)                                                00890803
      WRITE (I02, 90007)                                                00900803
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00910803
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00920803
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00930803
CBE** ********************** BBCHED0A **********************************00940803
C*****                                                                  00950803
C*****    HEADER FOR SEGMENT 158 WRITTEN                                00960803
        WRITE (NUVI,15801)                                              00970803
15801   FORMAT (" ", //1X,"YCABS - (158) INTRINSIC FUNCTION--" //16X,   00980803
     1         "CABS (ABSOLUTE VALUE)" //2X,                            00990803
     2         "ANS REF. - 15.3" )                                      01000803
CBB** ********************** BBCHED0B **********************************01010803
C**** WRITE DETAIL REPORT HEADERS                                       01020803
C****                                                                   01030803
      WRITE (I02,90004)                                                 01040803
      WRITE (I02,90004)                                                 01050803
      WRITE (I02,90013)                                                 01060803
      WRITE (I02,90014)                                                 01070803
      WRITE (I02,90015) IVTOTL                                          01080803
CBE** ********************** BBCHED0B **********************************01090803
C*****                                                                  01100803
CT001*  TEST 1                               COMPLEX VALUE ZERO (0,0)   01110803
           IVTNUM = 1                                                   01120803
        RPAVS = CABS((0.0, 0.0))                                        01130803
           IF (RPAVS + .00005) 20010, 10010, 40010                      01140803
40010      IF (RPAVS - .00005) 10010, 10010, 20010                      01150803
10010      IVPASS = IVPASS + 1                                          01160803
           WRITE (NUVI, 80002) IVTNUM                                   01170803
           GO TO 0011                                                   01180803
20010      IVFAIL = IVFAIL + 1                                          01190803
           RVCORR = 0.0                                                 01200803
           WRITE (NUVI, 80012) IVTNUM, RPAVS, RVCORR                    01210803
 0011      CONTINUE                                                     01220803
CT002*  TEST 2               COMPLEX VALUE HAVING ONLY REAL COMPONENT   01230803
           IVTNUM = 2                                                   01240803
        RPAVS = CABS((3.0, 0.0))                                        01250803
           IF (RPAVS - 2.9998) 20020, 10020, 40020                      01260803
40020      IF (RPAVS - 3.0002) 10020, 10020, 20020                      01270803
10020      IVPASS = IVPASS + 1                                          01280803
           WRITE (NUVI, 80002) IVTNUM                                   01290803
           GO TO 0021                                                   01300803
20020      IVFAIL = IVFAIL + 1                                          01310803
           RVCORR = 3.0                                                 01320803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01330803
 0021      CONTINUE                                                     01340803
CT003*  TEST 3          COMPLEX VALUE HAVING ONLY IMAGINARY COMPONENT   01350803
           IVTNUM = 3                                                   01360803
        RPAVS = CABS((0.0, 3.0))                                        01370803
           IF (RPAVS - 2.9998) 20030, 10030, 40030                      01380803
40030      IF (RPAVS - 3.0002) 10030, 10030, 20030                      01390803
10030      IVPASS = IVPASS + 1                                          01400803
           WRITE (NUVI, 80002) IVTNUM                                   01410803
           GO TO 0031                                                   01420803
20030      IVFAIL = IVFAIL + 1                                          01430803
           RVCORR = 3.0                                                 01440803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01450803
 0031      CONTINUE                                                     01460803
CT004*  TEST 4                                ARBITRARY COMPLEX VALUE   01470803
           IVTNUM = 4                                                   01480803
        RPAVS = CABS((3.0, 4.0))                                        01490803
           IF (RPAVS - 4.9997) 20040, 10040, 40040                      01500803
40040      IF (RPAVS - 5.0003) 10040, 10040, 20040                      01510803
10040      IVPASS = IVPASS + 1                                          01520803
           WRITE (NUVI, 80002) IVTNUM                                   01530803
           GO TO 0041                                                   01540803
20040      IVFAIL = IVFAIL + 1                                          01550803
           RVCORR = 5.0                                                 01560803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01570803
 0041      CONTINUE                                                     01580803
CT005*  TEST 5        NEGATIVE REAL COMPONENT, NO IMAGINARY COMPONENT   01590803
           IVTNUM = 5                                                   01600803
        RPAVS = CABS((-3.0, 0.0))                                       01610803
           IF (RPAVS - 2.9998) 20050, 10050, 40050                      01620803
40050      IF (RPAVS - 3.0002) 10050, 10050, 20050                      01630803
10050      IVPASS = IVPASS + 1                                          01640803
           WRITE (NUVI, 80002) IVTNUM                                   01650803
           GO TO 0051                                                   01660803
20050      IVFAIL = IVFAIL + 1                                          01670803
           RVCORR = 3.0                                                 01680803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01690803
 0051      CONTINUE                                                     01700803
CT006*  TEST 6        NO REAL COMPONENT, NEGATIVE IMAGINARY COMPONENT   01710803
           IVTNUM = 6                                                   01720803
        RPAVS = CABS((0.0, -3.0))                                       01730803
           IF (RPAVS - 2.9998) 20060, 10060, 40060                      01740803
40060      IF (RPAVS - 3.0002) 10060, 10060, 20060                      01750803
10060      IVPASS = IVPASS + 1                                          01760803
           WRITE (NUVI, 80002) IVTNUM                                   01770803
           GO TO 0061                                                   01780803
20060      IVFAIL = IVFAIL + 1                                          01790803
           RVCORR = 3.0                                                 01800803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01810803
 0061      CONTINUE                                                     01820803
CT007*  TEST 7       ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS   01830803
           IVTNUM = 7                                                   01840803
        RPAVS = CABS((-3.0, -4.0))                                      01850803
           IF (RPAVS - 4.9997) 20070, 10070, 40070                      01860803
40070      IF (RPAVS - 5.0003) 10070, 10070, 20070                      01870803
10070      IVPASS = IVPASS + 1                                          01880803
           WRITE (NUVI, 80002) IVTNUM                                   01890803
           GO TO 0071                                                   01900803
20070      IVFAIL = IVFAIL + 1                                          01910803
           RVCORR = 5.0                                                 01920803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     01930803
 0071      CONTINUE                                                     01940803
CT008*  TEST 8              COMPLEX VALUE ZERO PRECEDED BY MINUS SIGN   01950803
           IVTNUM = 8                                                   01960803
        CPAVC = (0.0, 0.0)                                              01970803
        RPAVS = CABS(-CPAVC)                                            01980803
           IF (RPAVS + 0.00005) 20080, 10080, 40080                     01990803
40080      IF (RPAVS - 0.00005) 10080, 10080, 20080                     02000803
10080      IVPASS = IVPASS + 1                                          02010803
           WRITE (NUVI, 80002) IVTNUM                                   02020803
           GO TO 0081                                                   02030803
20080      IVFAIL = IVFAIL + 1                                          02040803
           RVCORR = 0.0                                                 02050803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     02060803
 0081      CONTINUE                                                     02070803
CT009*  TEST 9               COMPLEX EXPRESSION PRESENTED AS ARGUMENT   02080803
           IVTNUM = 9                                                   02090803
        CPAVC = (3.0, 4.0)                                              02100803
        RPAVS = CABS(CPAVC - (3.0, 4.0))                                02110803
           IF (RPAVS + 0.00005) 20090, 10090, 40090                     02120803
40090      IF (RPAVS - 0.00005) 10090, 10090, 20090                     02130803
10090      IVPASS = IVPASS + 1                                          02140803
           WRITE (NUVI, 80002) IVTNUM                                   02150803
           GO TO 0091                                                   02160803
20090      IVFAIL = IVFAIL + 1                                          02170803
           RVCORR = 0.0                                                 02180803
           WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR                     02190803
 0091      CONTINUE                                                     02200803
C*****                                                                  02210803
CBB** ********************** BBCSUM0  **********************************02220803
C**** WRITE OUT TEST SUMMARY                                            02230803
C****                                                                   02240803
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02250803
      WRITE (I02, 90004)                                                02260803
      WRITE (I02, 90014)                                                02270803
      WRITE (I02, 90004)                                                02280803
      WRITE (I02, 90020) IVPASS                                         02290803
      WRITE (I02, 90022) IVFAIL                                         02300803
      WRITE (I02, 90024) IVDELE                                         02310803
      WRITE (I02, 90026) IVINSP                                         02320803
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02330803
CBE** ********************** BBCSUM0  **********************************02340803
CBB** ********************** BBCFOOT0 **********************************02350803
C**** WRITE OUT REPORT FOOTINGS                                         02360803
C****                                                                   02370803
      WRITE (I02,90016) ZPROG, ZPROG                                    02380803
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02390803
      WRITE (I02,90019)                                                 02400803
CBE** ********************** BBCFOOT0 **********************************02410803
CBB** ********************** BBCFMT0A **********************************02420803
C**** FORMATS FOR TEST DETAIL LINES                                     02430803
C****                                                                   02440803
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02450803
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02460803
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02470803
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02480803
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02490803
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02500803
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02510803
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02520803
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02530803
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02540803
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02550803
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02560803
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02570803
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02580803
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02590803
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02600803
80050 FORMAT (" ",48X,A31)                                              02610803
CBE** ********************** BBCFMT0A **********************************02620803
CBB** ********************** BBCFMAT1 **********************************02630803
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02640803
C****                                                                   02650803
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02660803
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02670803
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02680803
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02690803
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    02700803
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    02710803
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    02720803
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    02730803
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02740803
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  02750803
     2"(",F12.5,", ",F12.5,")")                                         02760803
CBE** ********************** BBCFMAT1 **********************************02770803
CBB** ********************** BBCFMT0B **********************************02780803
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                02790803
C****                                                                   02800803
90002 FORMAT ("1")                                                      02810803
90004 FORMAT (" ")                                                      02820803
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02830803
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02840803
90008 FORMAT (" ",21X,A13,A17)                                          02850803
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       02860803
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    02870803
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     02880803
     1       7X,"REMARKS",24X)                                          02890803
90014 FORMAT (" ","----------------------------------------------" ,    02900803
     1        "---------------------------------" )                     02910803
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               02920803
C****                                                                   02930803
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             02940803
C****                                                                   02950803
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          02960803
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        02970803
     1        A13)                                                      02980803
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 02990803
C****                                                                   03000803
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03010803
C****                                                                   03020803
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03030803
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03040803
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03050803
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03060803
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03070803
CBE** ********************** BBCFMT0B **********************************03080803
C*****                                                                  03090803
C*****    END OF TEST SEGMENT 158                                       03100803
        STOP                                                            03110803
        END                                                             03120803
                                                                        03130803