| 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 |
