PROGRAM FM817 C***********************************************************************00010817 C***** FORTRAN 77 00020817 C***** FM817 00030817 C***** YCLOG - (183) 00040817 C***** 00050817 C***********************************************************************00060817 C***** GENERAL PURPOSE ANS REF 00070817 C***** TEST INTRINSIC FUNCTION CLOG 15.3 00080817 C***** INTRINSIC FUNCTIONS AIMAG AND CMPLX ASSUMED WORKING TABLE 5 00090817 C***** 00100817 CBB** ********************** BBCCOMNT **********************************00110817 C**** 00120817 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130817 C**** VERSION 2.1 00140817 C**** 00150817 C**** 00160817 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170817 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180817 C**** SOFTWARE STANDARDS VALIDATION GROUP 00190817 C**** BUILDING 225 RM A266 00200817 C**** GAITHERSBURG, MD 20899 00210817 C**** 00220817 C**** 00230817 C**** 00240817 CBE** ********************** BBCCOMNT **********************************00250817 C***** 00260817 C***** S P E C I F I C A T I O N S SEGMENT 183 00270817 COMPLEX AVC, BVC, CVC, ZVCORR 00280817 REAL R2E(2) 00290817 EQUIVALENCE (AVC, R2E) 00300817 C***** 00310817 CBB** ********************** BBCINITA **********************************00320817 C**** SPECIFICATION STATEMENTS 00330817 C**** 00340817 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350817 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360817 CBE** ********************** BBCINITA **********************************00370817 CBB** ********************** BBCINITB **********************************00380817 C**** INITIALIZE SECTION 00390817 DATA ZVERS, ZVERSD, ZDATE 00400817 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410817 DATA ZCOMPL, ZNAME, ZTAPE 00420817 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430817 DATA ZPROJ, ZTAPED, ZPROG 00440817 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450817 DATA REMRKS /' '/ 00460817 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470817 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480817 C**** 00490817 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500817 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510817 CZ03 ZPROG = 'PROGRAM NAME' 00520817 CZ04 ZDATE = 'DATE OF TEST' 00530817 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540817 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550817 CZ07 ZNAME = 'NAME OF USER' 00560817 CZ08 ZTAPE = 'TAPE OWNER/ID' 00570817 CZ09 ZTAPED = 'DATE TAPE COPIED' 00580817 C 00590817 IVPASS = 0 00600817 IVFAIL = 0 00610817 IVDELE = 0 00620817 IVINSP = 0 00630817 IVTOTL = 0 00640817 IVTOTN = 0 00650817 ICZERO = 0 00660817 C 00670817 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680817 I01 = 05 00690817 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700817 I02 = 06 00710817 C 00720817 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730817 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740817 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750817 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760817 C 00770817 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780817 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790817 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800817 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810817 C 00820817 CBE** ********************** BBCINITB **********************************00830817 NUVI = I02 00840817 IVTOTL = 11 00850817 ZPROG = 'FM817' 00860817 CBB** ********************** BBCHED0A **********************************00870817 C**** 00880817 C**** WRITE REPORT TITLE 00890817 C**** 00900817 WRITE (I02, 90002) 00910817 WRITE (I02, 90006) 00920817 WRITE (I02, 90007) 00930817 WRITE (I02, 90008) ZVERS, ZVERSD 00940817 WRITE (I02, 90009) ZPROG, ZPROG 00950817 WRITE (I02, 90010) ZDATE, ZCOMPL 00960817 CBE** ********************** BBCHED0A **********************************00970817 C***** 00980817 C***** HEADER FOR SEGMENT 183 00990817 WRITE(NUVI,18300) 01000817 18300 FORMAT(" ", / " YCLOG - (183) INTRINSIC FUNCTIONS" // 01010817 1 " CLOG (COMPLEX NATURAL LOGARITHM)" // 01020817 2 " ANS REF. - 15.3" ) 01030817 CBB** ********************** BBCHED0B **********************************01040817 C**** WRITE DETAIL REPORT HEADERS 01050817 C**** 01060817 WRITE (I02,90004) 01070817 WRITE (I02,90004) 01080817 WRITE (I02,90013) 01090817 WRITE (I02,90014) 01100817 WRITE (I02,90015) IVTOTL 01110817 CBE** ********************** BBCHED0B **********************************01120817 C***** 01130817 PIVS = 3.1415926535897932384626434 01140817 C***** TESTS 1 THRU 3 - POSITIVE REAL NUMBERS--CLOG, ALOG AGREE ON 01150817 C***** REAL LINE 01160817 CT001* TEST 1 01170817 IVTNUM = 1 01180817 AVC = CLOG((1.0, 0.0)) 01190817 IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011 01200817 40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010 01210817 40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01220817 40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01230817 10010 IVPASS = IVPASS + 1 01240817 WRITE (NUVI, 80002) IVTNUM 01250817 GO TO 0011 01260817 20010 IVFAIL = IVFAIL + 1 01270817 ZVCORR = (0.00000000000000, 0.00000000000000) 01280817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01290817 0011 CONTINUE 01300817 CT002* TEST 2 01310817 IVTNUM = 2 01320817 AVC = CLOG((5.125, 0.0)) 01330817 IF (R2E(1) - 0.16340E+01) 20020, 40022, 40021 01340817 40021 IF (R2E(1) - 0.16343E+01) 40022, 40022, 20020 01350817 40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01360817 40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01370817 10020 IVPASS = IVPASS + 1 01380817 WRITE (NUVI, 80002) IVTNUM 01390817 GO TO 0021 01400817 20020 IVFAIL = IVFAIL + 1 01410817 ZVCORR = (1.6341305250245, 0.00000000000000) 01420817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01430817 0021 CONTINUE 01440817 CT003* TEST 3 01450817 IVTNUM = 3 01460817 AVC = CLOG((100.0, 0.0)) 01470817 IF (R2E(1) - 0.46049E+01) 20030, 40032, 40031 01480817 40031 IF (R2E(1) - 0.46054E+01) 40032, 40032, 20030 01490817 40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01500817 40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01510817 10030 IVPASS = IVPASS + 1 01520817 WRITE (NUVI, 80002) IVTNUM 01530817 GO TO 0031 01540817 20030 IVFAIL = IVFAIL + 1 01550817 ZVCORR = (4.6051701859881, 0.00000000000000) 01560817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01570817 0031 CONTINUE 01580817 CT004* TEST 4 AN EXPRESSION PRESENTED TO CLOG 01590817 IVTNUM = 4 01600817 AVC = CLOG((2.6875, 0.0) * (-1.0, 0.0)) 01610817 IF (R2E(1) - 0.98856E+00) 20040, 40042, 40041 01620817 40041 IF (R2E(1) - 0.98866E+00) 40042, 40042, 20040 01630817 40042 IF (R2E(2) - 0.31414E+01) 20040, 10040, 40040 01640817 40040 IF (R2E(2) - 0.31418E+01) 10040, 10040, 20040 01650817 10040 IVPASS = IVPASS + 1 01660817 WRITE (NUVI, 80002) IVTNUM 01670817 GO TO 0041 01680817 20040 IVFAIL = IVFAIL + 1 01690817 ZVCORR = (0.98861139345378, 3.1415926535898) 01700817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01710817 0041 CONTINUE 01720817 C***** TESTS 5 AND 6 - NEGATIVE REAL NUMBERS--CHECK RIGHT BRANCH AT 01730817 C***** ENDPOINTS 01740817 CT005* TEST 5 01750817 IVTNUM = 5 01760817 BVC = (-2.5, 0.0) 01770817 AVC = CLOG(BVC + BVC) 01780817 IF (R2E(1) - 0.16093E+01) 20050, 40052, 40051 01790817 40051 IF (R2E(1) - 0.16096E+01) 40052, 40052, 20050 01800817 40052 IF (R2E(2) - 0.31414E+01) 20050, 10050, 40050 01810817 40050 IF (R2E(2) - 0.31418E+01) 10050, 10050, 20050 01820817 10050 IVPASS = IVPASS + 1 01830817 WRITE (NUVI, 80002) IVTNUM 01840817 GO TO 0051 01850817 20050 IVFAIL = IVFAIL + 1 01860817 ZVCORR = (1.6094379124341, 3.1415926535898) 01870817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01880817 0051 CONTINUE 01890817 CT006* TEST 6 01900817 IVTNUM = 6 01910817 BVC = (-10.0, 0.0) + (-10.25, 0.0) 01920817 AVC = CLOG(BVC) 01930817 IF (R2E(1) - 0.30080E+01) 20060, 40062, 40061 01940817 40061 IF (R2E(1) - 0.30083E+01) 40062, 40062, 20060 01950817 40062 IF (R2E(2) - 0.31414E+01) 20060, 10060, 40060 01960817 40060 IF (R2E(2) - 0.31418E+01) 10060, 10060, 20060 01970817 10060 IVPASS = IVPASS + 1 01980817 WRITE (NUVI, 80002) IVTNUM 01990817 GO TO 0061 02000817 20060 IVFAIL = IVFAIL + 1 02010817 ZVCORR = (3.0081547935525, 3.1415926535898) 02020817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02030817 0061 CONTINUE 02040817 CT007* TEST 7 POSITIVE REAL, POSITIVE IMAGINARY ARGUMENTS 02050817 IVTNUM = 7 02060817 BVC = (2.0, 1.5) 02070817 AVC = CLOG(BVC) 02080817 IF (R2E(1) - 0.91624E+00) 20070, 40072, 40071 02090817 40071 IF (R2E(1) - 0.91634E+00) 40072, 40072, 20070 02100817 40072 IF (R2E(2) - 0.64346E+00) 20070, 10070, 40070 02110817 40070 IF (R2E(2) - 0.64354E+00) 10070, 10070, 20070 02120817 10070 IVPASS = IVPASS + 1 02130817 WRITE (NUVI, 80002) IVTNUM 02140817 GO TO 0071 02150817 20070 IVFAIL = IVFAIL + 1 02160817 ZVCORR = (0.91629073187416, 0.64350110879328) 02170817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02180817 0071 CONTINUE 02190817 CT008* TEST 8 NEGATIVE REAL, POSITIVE IMAGINARY ARGUMENTS 02200817 IVTNUM = 8 02210817 BVC = (-2.75, 1.375) 02220817 AVC = CLOG(BVC) 02230817 IF (R2E(1) - 0.11231E+01) 20080, 40082, 40081 02240817 40081 IF (R2E(1) - 0.11233E+01) 40082, 40082, 20080 02250817 40082 IF (R2E(2) - 0.26778E+01) 20080, 10080, 40080 02260817 40080 IF (R2E(2) - 0.26781E+01) 10080, 10080, 20080 02270817 10080 IVPASS = IVPASS + 1 02280817 WRITE (NUVI, 80002) IVTNUM 02290817 GO TO 0081 02300817 20080 IVFAIL = IVFAIL + 1 02310817 ZVCORR = (1.1231726873356, 2.6779450445890) 02320817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02330817 0081 CONTINUE 02340817 CT009* TEST 9 NEGATIVE REAL, NEGATIVE IMAGINARY ARGUMENTS 02350817 IVTNUM = 9 02360817 BVC = (-10.0, -10.0) 02370817 AVC = CLOG(BVC) 02380817 IF (R2E(1) - 0.26490E+01) 20090, 40092, 40091 02390817 40091 IF (R2E(1) - 0.26493E+01) 40092, 40092, 20090 02400817 40092 IF (R2E(2) + 0.23564E+01) 20090, 10090, 40090 02410817 40090 IF (R2E(2) + 0.23560E+01) 10090, 10090, 20090 02420817 10090 IVPASS = IVPASS + 1 02430817 WRITE (NUVI, 80002) IVTNUM 02440817 GO TO 0091 02450817 20090 IVFAIL = IVFAIL + 1 02460817 ZVCORR = (2.6491586832740, -2.3561944901923) 02470817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02480817 0091 CONTINUE 02490817 CT010* TEST 10 CLOG USED TOGETHER WITH AIMAG 02500817 IVTNUM = 10 02510817 AVS = (AIMAG(CLOG((3.0, 1.75))) + AIMAG(CLOG((-3.0, 1.75)))) 02520817 1 - PIVS 02530817 IF (AVS + 0.50000E-04) 20100, 10100, 40100 02540817 40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100 02550817 10100 IVPASS = IVPASS + 1 02560817 WRITE (NUVI, 80002) IVTNUM 02570817 GO TO 0101 02580817 20100 IVFAIL = IVFAIL + 1 02590817 RVCORR = 0.00000000000000 02600817 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02610817 0101 CONTINUE 02620817 CT011* TEST 11 CLOG USED TOGETHER WITH CMPLX AND AIMAG 02630817 IVTNUM = 11 02640817 BVC = CLOG((4.5, -3.75)) 02650817 CVC = CLOG((-4.5, -3.75)) 02660817 AVC = (BVC - CMPLX(0.0, AIMAG(BVC))) - 02670817 1 (CVC - CMPLX(0.0, AIMAG(CVC))) 02680817 IF (R2E(1) + 0.50000E-04) 20110, 40112, 40111 02690817 40111 IF (R2E(1) - 0.50000E-04) 40112, 40112, 20110 02700817 40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110 02710817 40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110 02720817 10110 IVPASS = IVPASS + 1 02730817 WRITE (NUVI, 80002) IVTNUM 02740817 GO TO 0111 02750817 20110 IVFAIL = IVFAIL + 1 02760817 ZVCORR = (0.00000000000000, 0.00000000000000) 02770817 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02780817 0111 CONTINUE 02790817 C***** 02800817 CBB** ********************** BBCSUM0 **********************************02810817 C**** WRITE OUT TEST SUMMARY 02820817 C**** 02830817 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02840817 WRITE (I02, 90004) 02850817 WRITE (I02, 90014) 02860817 WRITE (I02, 90004) 02870817 WRITE (I02, 90020) IVPASS 02880817 WRITE (I02, 90022) IVFAIL 02890817 WRITE (I02, 90024) IVDELE 02900817 WRITE (I02, 90026) IVINSP 02910817 WRITE (I02, 90028) IVTOTN, IVTOTL 02920817 CBE** ********************** BBCSUM0 **********************************02930817 CBB** ********************** BBCFOOT0 **********************************02940817 C**** WRITE OUT REPORT FOOTINGS 02950817 C**** 02960817 WRITE (I02,90016) ZPROG, ZPROG 02970817 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02980817 WRITE (I02,90019) 02990817 CBE** ********************** BBCFOOT0 **********************************03000817 CBB** ********************** BBCFMT0A **********************************03010817 C**** FORMATS FOR TEST DETAIL LINES 03020817 C**** 03030817 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03040817 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03050817 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03060817 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03070817 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03080817 1I6,/," ",15X,"CORRECT= " ,I6) 03090817 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100817 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03110817 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03120817 1A21,/," ",16X,"CORRECT= " ,A21) 03130817 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03140817 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03150817 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03160817 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03170817 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03180817 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03190817 80050 FORMAT (" ",48X,A31) 03200817 CBE** ********************** BBCFMT0A **********************************03210817 CBB** ********************** BBCFMAT1 **********************************03220817 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03230817 C**** 03240817 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250817 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03260817 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03270817 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03280817 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03290817 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03300817 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03310817 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03320817 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330817 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03340817 2"(",F12.5,", ",F12.5,")") 03350817 CBE** ********************** BBCFMAT1 **********************************03360817 CBB** ********************** BBCFMT0B **********************************03370817 C**** FORMAT STATEMENTS FOR PAGE HEADERS 03380817 C**** 03390817 90002 FORMAT ("1") 03400817 90004 FORMAT (" ") 03410817 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03420817 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03430817 90008 FORMAT (" ",21X,A13,A17) 03440817 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03450817 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03460817 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03470817 1 7X,"REMARKS",24X) 03480817 90014 FORMAT (" ","----------------------------------------------" , 03490817 1 "---------------------------------" ) 03500817 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03510817 C**** 03520817 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03530817 C**** 03540817 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03550817 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03560817 1 A13) 03570817 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03580817 C**** 03590817 C**** FORMAT STATEMENTS FOR RUN SUMMARY 03600817 C**** 03610817 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03620817 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03630817 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03640817 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03650817 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03660817 CBE** ********************** BBCFMT0B **********************************03670817 C***** 03680817 C***** END OF TEST SEGMENT 183 03690817 STOP 03700817 END 03710817 03720817