PROGRAM FM815 C***********************************************************************00010815 C***** FORTRAN 77 00020815 C***** FM815 00030815 C***** YCEXP - (180) 00040815 C***** 00050815 C***********************************************************************00060815 C***** GENERAL PURPOSE ANS REF 00070815 C***** TEST INTRINSIC FUNCTION CEXP 15.3 00080815 C***** INTRINSIC FUNCTIONS AIMAG AND CABS ASSUMED WORKING TABLE 5 00090815 C***** 00100815 CBB** ********************** BBCCOMNT **********************************00110815 C**** 00120815 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130815 C**** VERSION 2.1 00140815 C**** 00150815 C**** 00160815 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170815 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180815 C**** SOFTWARE STANDARDS VALIDATION GROUP 00190815 C**** BUILDING 225 RM A266 00200815 C**** GAITHERSBURG, MD 20899 00210815 C**** 00220815 C**** 00230815 C**** 00240815 CBE** ********************** BBCCOMNT **********************************00250815 C***** 00260815 C***** S P E C I F I C A T I O N S SEGMENT 180 00270815 COMPLEX AVC, BVC, CVC, ZVCORR 00280815 REAL R2E(2) 00290815 EQUIVALENCE (AVC, R2E) 00300815 C***** 00310815 CBB** ********************** BBCINITA **********************************00320815 C**** SPECIFICATION STATEMENTS 00330815 C**** 00340815 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350815 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360815 CBE** ********************** BBCINITA **********************************00370815 CBB** ********************** BBCINITB **********************************00380815 C**** INITIALIZE SECTION 00390815 DATA ZVERS, ZVERSD, ZDATE 00400815 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410815 DATA ZCOMPL, ZNAME, ZTAPE 00420815 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430815 DATA ZPROJ, ZTAPED, ZPROG 00440815 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450815 DATA REMRKS /' '/ 00460815 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470815 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480815 C**** 00490815 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500815 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510815 CZ03 ZPROG = 'PROGRAM NAME' 00520815 CZ04 ZDATE = 'DATE OF TEST' 00530815 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540815 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550815 CZ07 ZNAME = 'NAME OF USER' 00560815 CZ08 ZTAPE = 'TAPE OWNER/ID' 00570815 CZ09 ZTAPED = 'DATE TAPE COPIED' 00580815 C 00590815 IVPASS = 0 00600815 IVFAIL = 0 00610815 IVDELE = 0 00620815 IVINSP = 0 00630815 IVTOTL = 0 00640815 IVTOTN = 0 00650815 ICZERO = 0 00660815 C 00670815 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680815 I01 = 05 00690815 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700815 I02 = 06 00710815 C 00720815 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730815 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740815 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750815 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760815 C 00770815 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780815 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790815 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800815 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810815 C 00820815 CBE** ********************** BBCINITB **********************************00830815 NUVI = I02 00840815 IVTOTL = 9 00850815 ZPROG = 'FM815' 00860815 CBB** ********************** BBCHED0A **********************************00870815 C**** 00880815 C**** WRITE REPORT TITLE 00890815 C**** 00900815 WRITE (I02, 90002) 00910815 WRITE (I02, 90006) 00920815 WRITE (I02, 90007) 00930815 WRITE (I02, 90008) ZVERS, ZVERSD 00940815 WRITE (I02, 90009) ZPROG, ZPROG 00950815 WRITE (I02, 90010) ZDATE, ZCOMPL 00960815 CBE** ********************** BBCHED0A **********************************00970815 C***** 00980815 C***** HEADER FOR SEGMENT 180 00990815 WRITE(NUVI,18000) 01000815 18000 FORMAT(" ", / " YCEXP - (180) INTRINSIC FUNCTIONS" // 01010815 1 " CEXP (COMPLEX EXPONENTIAL)" // 01020815 2 " ANS REF. - 15.3" ) 01030815 CBB** ********************** BBCHED0B **********************************01040815 C**** WRITE DETAIL REPORT HEADERS 01050815 C**** 01060815 WRITE (I02,90004) 01070815 WRITE (I02,90004) 01080815 WRITE (I02,90013) 01090815 WRITE (I02,90014) 01100815 WRITE (I02,90015) IVTOTL 01110815 CBE** ********************** BBCHED0B **********************************01120815 C***** 01130815 CT001* TEST 1 ZERO 01140815 IVTNUM = 1 01150815 BVC = (0.0, 0.0) 01160815 AVC = CEXP(BVC) 01170815 IF (R2E(1) - 0.99995E+00) 20010, 40012, 40011 01180815 40011 IF (R2E(1) - 0.10001E+01) 40012, 40012, 20010 01190815 40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01200815 40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01210815 10010 IVPASS = IVPASS + 1 01220815 WRITE (NUVI, 80002) IVTNUM 01230815 GO TO 0011 01240815 20010 IVFAIL = IVFAIL + 1 01250815 ZVCORR = (1.0000000000000, 0.00000000000000) 01260815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01270815 0011 CONTINUE 01280815 CT002* TEST 2 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP 01290815 IVTNUM = 2 01300815 AVC = CEXP((1.0, 0.0)) 01310815 IF (R2E(1) - 0.27181E+01) 20020, 40022, 40021 01320815 40021 IF (R2E(1) - 0.27185E+01) 40022, 40022, 20020 01330815 40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01340815 40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01350815 10020 IVPASS = IVPASS + 1 01360815 WRITE (NUVI, 80002) IVTNUM 01370815 GO TO 0021 01380815 20020 IVFAIL = IVFAIL + 1 01390815 ZVCORR = (2.7182818284590, 0.00000000000000) 01400815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01410815 0021 CONTINUE 01420815 CT003* TEST 3 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP 01430815 IVTNUM = 3 01440815 BVC = (-3.0, 0.0) 01450815 AVC = CEXP(BVC) 01460815 IF (R2E(1) - 0.49784E-01) 20030, 40032, 40031 01470815 40031 IF (R2E(1) - 0.49790E-01) 40032, 40032, 20030 01480815 40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01490815 40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01500815 10030 IVPASS = IVPASS + 1 01510815 WRITE (NUVI, 80002) IVTNUM 01520815 GO TO 0031 01530815 20030 IVFAIL = IVFAIL + 1 01540815 ZVCORR = (0.04978706836785, 0.00000000000000) 01550815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01560815 0031 CONTINUE 01570815 C***** TESTS 4 AND 5 - PURELY IMAGINARY NUMBERS--RESULT LIES 01580815 C***** ON UNIT CIRCLE 01590815 CT004* TEST 4 (0,PI) 01600815 IVTNUM = 4 01610815 BVC = (0.0, 3.1415926536) 01620815 AVC = CEXP(BVC * (1.0, 0.0)) 01630815 IF (R2E(1) + 0.10001E+01) 20040, 40042, 40041 01640815 40041 IF (R2E(1) + 0.99995E+00) 40042, 40042, 20040 01650815 40042 IF (R2E(2) + 0.50000E-04) 20040, 10040, 40040 01660815 40040 IF (R2E(2) - 0.50000E-04) 10040, 10040, 20040 01670815 10040 IVPASS = IVPASS + 1 01680815 WRITE (NUVI, 80002) IVTNUM 01690815 GO TO 0041 01700815 20040 IVFAIL = IVFAIL + 1 01710815 ZVCORR = (-1.0000000000000, 0.00000000000000) 01720815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01730815 0041 CONTINUE 01740815 CT005* TEST 5 (0,-PI/2) 01750815 IVTNUM = 5 01760815 BVC = (0.0, -3.1415926536) 01770815 AVC = CEXP(BVC / (2.0, 0.0)) 01780815 IF (R2E(1) + 0.50000E-04) 20050, 40052, 40051 01790815 40051 IF (R2E(1) - 0.50000E-04) 40052, 40052, 20050 01800815 40052 IF (R2E(2) + 0.10001E+01) 20050, 10050, 40050 01810815 40050 IF (R2E(2) + 0.99995E+00) 10050, 10050, 20050 01820815 10050 IVPASS = IVPASS + 1 01830815 WRITE (NUVI, 80002) IVTNUM 01840815 GO TO 0051 01850815 20050 IVFAIL = IVFAIL + 1 01860815 ZVCORR = (0.00000000000000, -1.0000000000000) 01870815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01880815 0051 CONTINUE 01890815 CT006* TEST 6 (2.5,PI/4) 01900815 IVTNUM = 6 01910815 AVC = CEXP((1.0, 2.0)) 01920815 IF (R2E(1) + 0.11313E+01) 20060, 40062, 40061 01930815 40061 IF (R2E(1) + 0.11311E+01) 40062, 40062, 20060 01940815 40062 IF (R2E(2) - 0.24716E+01) 20060, 10060, 40060 01950815 40060 IF (R2E(2) - 0.24719E+01) 10060, 10060, 20060 01960815 10060 IVPASS = IVPASS + 1 01970815 WRITE (NUVI, 80002) IVTNUM 01980815 GO TO 0061 01990815 20060 IVFAIL = IVFAIL + 1 02000815 ZVCORR = (-1.1312043837568, 2.4717266720048) 02010815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02020815 0061 CONTINUE 02030815 CT007* TEST 7 A VARIABLE SUPPLIED TO CEXP 02040815 IVTNUM = 7 02050815 BVC = (-1.75, 4.625) 02060815 AVC = CEXP(BVC) 02070815 IF (R2E(1) + 0.15168E-01) 20070, 40072, 40071 02080815 40071 IF (R2E(1) + 0.15165E-01) 40072, 40072, 20070 02090815 40072 IF (R2E(2) + 0.17312E+00) 20070, 10070, 40070 02100815 40070 IF (R2E(2) + 0.17310E+00) 10070, 10070, 20070 02110815 10070 IVPASS = IVPASS + 1 02120815 WRITE (NUVI, 80002) IVTNUM 02130815 GO TO 0071 02140815 20070 IVFAIL = IVFAIL + 1 02150815 ZVCORR = (-0.01516660638013, -0.17311082425206) 02160815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02170815 0071 CONTINUE 02180815 CT008* TEST 8 POSITIVE REAL, NEGATIVE IMAGINARY ARGUMENT 02190815 IVTNUM = 8 02200815 AVC = CEXP((5.5, -1.015625)) 02210815 IF (R2E(1) - 0.12896E+03) 20080, 40082, 40081 02220815 40081 IF (R2E(1) - 0.12898E+03) 40082, 40082, 20080 02230815 40082 IF (R2E(2) + 0.20796E+03) 20080, 10080, 40080 02240815 40080 IF (R2E(2) + 0.20793E+03) 10080, 10080, 20080 02250815 10080 IVPASS = IVPASS + 1 02260815 WRITE (NUVI, 80002) IVTNUM 02270815 GO TO 0081 02280815 20080 IVFAIL = IVFAIL + 1 02290815 ZVCORR = (128.97440219594, -207.94168724284) 02300815 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02310815 0081 CONTINUE 02320815 CT009* TEST 9 THE FUNCTION TOGETHER WITH AIMAG AND CABS 02330815 IVTNUM = 9 02340815 BVC = (10.0, 3.1415926536) 02350815 CVC = CEXP(BVC / (4.0, 0.0)) 02360815 AVS = (AIMAG(CVC) / CABS(CVC)) ** 2 02370815 IF (AVS - 0.49997E+00) 20090, 10090, 40090 02380815 40090 IF (AVS - 0.50003E+00) 10090, 10090, 20090 02390815 10090 IVPASS = IVPASS + 1 02400815 WRITE (NUVI, 80002) IVTNUM 02410815 GO TO 0091 02420815 20090 IVFAIL = IVFAIL + 1 02430815 RVCORR = 0.5000000 02440815 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02450815 0091 CONTINUE 02460815 C***** 02470815 CBB** ********************** BBCSUM0 **********************************02480815 C**** WRITE OUT TEST SUMMARY 02490815 C**** 02500815 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02510815 WRITE (I02, 90004) 02520815 WRITE (I02, 90014) 02530815 WRITE (I02, 90004) 02540815 WRITE (I02, 90020) IVPASS 02550815 WRITE (I02, 90022) IVFAIL 02560815 WRITE (I02, 90024) IVDELE 02570815 WRITE (I02, 90026) IVINSP 02580815 WRITE (I02, 90028) IVTOTN, IVTOTL 02590815 CBE** ********************** BBCSUM0 **********************************02600815 CBB** ********************** BBCFOOT0 **********************************02610815 C**** WRITE OUT REPORT FOOTINGS 02620815 C**** 02630815 WRITE (I02,90016) ZPROG, ZPROG 02640815 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02650815 WRITE (I02,90019) 02660815 CBE** ********************** BBCFOOT0 **********************************02670815 CBB** ********************** BBCFMT0A **********************************02680815 C**** FORMATS FOR TEST DETAIL LINES 02690815 C**** 02700815 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02710815 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02720815 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02730815 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02740815 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02750815 1I6,/," ",15X,"CORRECT= " ,I6) 02760815 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02770815 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02780815 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02790815 1A21,/," ",16X,"CORRECT= " ,A21) 02800815 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02810815 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02820815 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02830815 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02840815 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02850815 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02860815 80050 FORMAT (" ",48X,A31) 02870815 CBE** ********************** BBCFMT0A **********************************02880815 CBB** ********************** BBCFMAT1 **********************************02890815 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02900815 C**** 02910815 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02920815 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02930815 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02940815 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02950815 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02960815 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02970815 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02980815 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02990815 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03000815 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03010815 2"(",F12.5,", ",F12.5,")") 03020815 CBE** ********************** BBCFMAT1 **********************************03030815 CBB** ********************** BBCFMT0B **********************************03040815 C**** FORMAT STATEMENTS FOR PAGE HEADERS 03050815 C**** 03060815 90002 FORMAT ("1") 03070815 90004 FORMAT (" ") 03080815 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03090815 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03100815 90008 FORMAT (" ",21X,A13,A17) 03110815 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03120815 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03130815 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03140815 1 7X,"REMARKS",24X) 03150815 90014 FORMAT (" ","----------------------------------------------" , 03160815 1 "---------------------------------" ) 03170815 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03180815 C**** 03190815 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03200815 C**** 03210815 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03220815 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03230815 1 A13) 03240815 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03250815 C**** 03260815 C**** FORMAT STATEMENTS FOR RUN SUMMARY 03270815 C**** 03280815 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03290815 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03300815 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03310815 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03320815 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03330815 CBE** ********************** BBCFMT0B **********************************03340815 C***** 03350815 C***** END OF TEST SEGMENT 180 03360815 STOP 03370815 END 03380815 03390815