blob: 31d274734f3ab23ffaa4f7b60e24200eec51b3fe [file] [log] [blame]
PROGRAM FM824
C***********************************************************************00010824
C***** FORTRAN 77 00020824
C***** FM824 00030824
C***** YDATAN - (196) 00040824
C***** 00050824
C***********************************************************************00060824
C***** GENERAL PURPOSE ANS REF 00070824
C***** TEST INTRINSIC FUNCTION DATAN, DATAN2 15.3 00080824
C***** INTRINSIC FUNCTION DSQRT ASSUMED WORKING TABLE 5 00090824
C***** 00100824
CBB** ********************** BBCCOMNT **********************************00110824
C**** 00120824
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130824
C**** VERSION 2.1 00140824
C**** 00150824
C**** 00160824
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170824
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180824
C**** SOFTWARE STANDARDS VALIDATION GROUP 00190824
C**** BUILDING 225 RM A266 00200824
C**** GAITHERSBURG, MD 20899 00210824
C**** 00220824
C**** 00230824
C**** 00240824
CBE** ********************** BBCCOMNT **********************************00250824
C***** 00260824
C***** S P E C I F I C A T I O N S SEGMENT 196 00270824
DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00280824
C***** 00290824
CBB** ********************** BBCINITA **********************************00300824
C**** SPECIFICATION STATEMENTS 00310824
C**** 00320824
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330824
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340824
CBE** ********************** BBCINITA **********************************00350824
CBB** ********************** BBCINITB **********************************00360824
C**** INITIALIZE SECTION 00370824
DATA ZVERS, ZVERSD, ZDATE 00380824
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390824
DATA ZCOMPL, ZNAME, ZTAPE 00400824
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410824
DATA ZPROJ, ZTAPED, ZPROG 00420824
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430824
DATA REMRKS /' '/ 00440824
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450824
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460824
C**** 00470824
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480824
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490824
CZ03 ZPROG = 'PROGRAM NAME' 00500824
CZ04 ZDATE = 'DATE OF TEST' 00510824
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520824
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530824
CZ07 ZNAME = 'NAME OF USER' 00540824
CZ08 ZTAPE = 'TAPE OWNER/ID' 00550824
CZ09 ZTAPED = 'DATE TAPE COPIED' 00560824
C 00570824
IVPASS = 0 00580824
IVFAIL = 0 00590824
IVDELE = 0 00600824
IVINSP = 0 00610824
IVTOTL = 0 00620824
IVTOTN = 0 00630824
ICZERO = 0 00640824
C 00650824
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660824
I01 = 05 00670824
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680824
I02 = 06 00690824
C 00700824
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710824
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720824
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730824
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740824
C 00750824
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760824
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770824
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780824
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790824
C 00800824
CBE** ********************** BBCINITB **********************************00810824
NUVI = I02 00820824
IVTOTL = 13 00830824
ZPROG = 'FM824' 00840824
CBB** ********************** BBCHED0A **********************************00850824
C**** 00860824
C**** WRITE REPORT TITLE 00870824
C**** 00880824
WRITE (I02, 90002) 00890824
WRITE (I02, 90006) 00900824
WRITE (I02, 90007) 00910824
WRITE (I02, 90008) ZVERS, ZVERSD 00920824
WRITE (I02, 90009) ZPROG, ZPROG 00930824
WRITE (I02, 90010) ZDATE, ZCOMPL 00940824
CBE** ********************** BBCHED0A **********************************00950824
C***** 00960824
C***** HEADER FOR SEGMENT 196 00970824
WRITE(NUVI,19600) 00980824
19600 FORMAT(" ", / " YDATAN - (196) INTRINSIC FUNCTIONS" // 00990824
1 " DATAN, DATAN2 (DOUBLE PRECISION ARCTANGENT)" // 01000824
2 " ANS REF. - 15.3" ) 01010824
CBB** ********************** BBCHED0B **********************************01020824
C**** WRITE DETAIL REPORT HEADERS 01030824
C**** 01040824
WRITE (I02,90004) 01050824
WRITE (I02,90004) 01060824
WRITE (I02,90013) 01070824
WRITE (I02,90014) 01080824
WRITE (I02,90015) IVTOTL 01090824
CBE** ********************** BBCHED0B **********************************01100824
C***** 01110824
WRITE(NUVI,19601) 01120824
19601 FORMAT(/ 8X, "TEST OF DATAN" ) 01130824
C***** 01140824
CT001* TEST 1 LARGE ARGUMENT VALUES TO TEST SINGULARITY 01150824
IVTNUM = 1 01160824
BVD = 500.0D0 01170824
AVD = DATAN(BVD) 01180824
IF (AVD - 0.1568796328D+01) 20010, 10010, 40010 01190824
40010 IF (AVD - 0.1568796331D+01) 10010, 10010, 20010 01200824
10010 IVPASS = IVPASS + 1 01210824
WRITE (NUVI, 80002) IVTNUM 01220824
GO TO 0011 01230824
20010 IVFAIL = IVFAIL + 1 01240824
DVCORR = 1.5687963294632946155D+00 01250824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01260824
0011 CONTINUE 01270824
CT002* TEST 2 LARGE ARGUMENT VALUES TO TEST SINGULARITY 01280824
IVTNUM = 2 01290824
AVD = DATAN(-1000.0D0) 01300824
IF (AVD + 0.1569796328D+01) 20020, 10020, 40020 01310824
40020 IF (AVD + 0.1569796326D+01) 10020, 10020, 20020 01320824
10020 IVPASS = IVPASS + 1 01330824
WRITE (NUVI, 80002) IVTNUM 01340824
GO TO 0021 01350824
20020 IVFAIL = IVFAIL + 1 01360824
DVCORR = -1.5697963271282297525D+00 01370824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01380824
0021 CONTINUE 01390824
CT003* TEST 3 AN EXPRESSION PRESENTED TO DATAN 01400824
IVTNUM = 3 01410824
AVD = DATAN(100.0D0 / 100.0D0) 01420824
IF (AVD - 0.7853981630D+00) 20030, 10030, 40030 01430824
40030 IF (AVD - 0.7853981638D+00) 10030, 10030, 20030 01440824
10030 IVPASS = IVPASS + 1 01450824
WRITE (NUVI, 80002) IVTNUM 01460824
GO TO 0031 01470824
20030 IVFAIL = IVFAIL + 1 01480824
DVCORR = 0.78539816339744830962D+00 01490824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01500824
0031 CONTINUE 01510824
CT004* TEST 4 THE FUNCTION DSQRT EVALUATED AND PRESENTED 01520824
C***** AS AN ARGUMENT 01530824
IVTNUM = 4 01540824
BVD = -DSQRT(3.0D0) 01550824
AVD = DATAN(BVD) 01560824
IF (AVD + 0.1047197552D+01) 20040, 10040, 40040 01570824
40040 IF (AVD + 0.1047197550D+01) 10040, 10040, 20040 01580824
10040 IVPASS = IVPASS + 1 01590824
WRITE (NUVI, 80002) IVTNUM 01600824
GO TO 0041 01610824
20040 IVFAIL = IVFAIL + 1 01620824
DVCORR = -1.0471975511965977461D+00 01630824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01640824
0041 CONTINUE 01650824
CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE 01660824
IVTNUM = 5 01670824
AVD = DATAN(1.0D-16) 01680824
IF (AVD - 0.9999999995D-16) 20050, 10050, 40050 01690824
40050 IF (AVD - 0.1000000001D-15) 10050, 10050, 20050 01700824
10050 IVPASS = IVPASS + 1 01710824
WRITE (NUVI, 80002) IVTNUM 01720824
GO TO 0051 01730824
20050 IVFAIL = IVFAIL + 1 01740824
DVCORR = 1.0000000000000000000D-16 01750824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01760824
0051 CONTINUE 01770824
CT006* TEST 6 AN ARGUMENT OF HIGH MAGNITUDE 01780824
IVTNUM = 6 01790824
AVD = DATAN(-2.0D+34) 01800824
IF (AVD + 0.1570796328D+01) 20060, 10060, 40060 01810824
40060 IF (AVD + 0.1570796326D+01) 10060, 10060, 20060 01820824
10060 IVPASS = IVPASS + 1 01830824
WRITE (NUVI, 80002) IVTNUM 01840824
GO TO 0061 01850824
20060 IVFAIL = IVFAIL + 1 01860824
DVCORR = -1.5707963267948966192D+00 01870824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01880824
0061 CONTINUE 01890824
C***** 01900824
WRITE(NUVI,19608) 01910824
19608 FORMAT(/ 08X, "TEST OF DATAN2" ) 01920824
CT007* TEST 7 TEST (0,POSITIVE) TO TEST DISCONTINUITY 01930824
IVTNUM = 7 01940824
BVD = 10.0D0 / 10.0D0 01950824
CVD = 0.0D0 01960824
AVD = DATAN2(CVD, BVD) 01970824
IF (AVD + 0.5000000000D-09) 20070, 10070, 40070 01980824
40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070 01990824
10070 IVPASS = IVPASS + 1 02000824
WRITE (NUVI, 80002) IVTNUM 02010824
GO TO 0071 02020824
20070 IVFAIL = IVFAIL + 1 02030824
DVCORR = 0.00000000000000000000D+00 02040824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02050824
0071 CONTINUE 02060824
CT008* TEST 8 TEST (0,NEGATIVE) TO TEST DISCONTINUITY 02070824
IVTNUM = 8 02080824
BVD = 0.0D0 02090824
CVD = -25.0D0 / 2.0D0 02100824
AVD = DATAN2(BVD, CVD) 02110824
IF (AVD - 0.3141592652D+01) 20080, 10080, 40080 02120824
40080 IF (AVD - 0.3141592655D+01) 10080, 10080, 20080 02130824
10080 IVPASS = IVPASS + 1 02140824
WRITE (NUVI, 80002) IVTNUM 02150824
GO TO 0081 02160824
20080 IVFAIL = IVFAIL + 1 02170824
DVCORR = 3.1415926535897932384D+00 02180824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02190824
0081 CONTINUE 02200824
CT009* TEST 9 AN EXPRESSION PRESENTED TO DATAN2 02210824
IVTNUM = 9 02220824
BVD = 1.0D0 02230824
CVD = BVD + BVD 02240824
AVD = DATAN2(BVD * 2.0D0, CVD) 02250824
IF (AVD - 0.7853981630D+00) 20090, 10090, 40090 02260824
40090 IF (AVD - 0.7853981638D+00) 10090, 10090, 20090 02270824
10090 IVPASS = IVPASS + 1 02280824
WRITE (NUVI, 80002) IVTNUM 02290824
GO TO 0091 02300824
20090 IVFAIL = IVFAIL + 1 02310824
DVCORR = 0.78539816339744830962D+00 02320824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02330824
0091 CONTINUE 02340824
CT010* TEST 10 ARGUMENTS WHERE (X,Y) X IS NEAR ZERO 02350824
IVTNUM = 10 02360824
BVD = DASIN(0.6D0) 02370824
CVD = DACOS(0.8D0) 02380824
AVD = DATAN2(BVD, CVD) 02390824
IF (AVD - 0.7853981630D+00) 20100, 10100, 40100 02400824
40100 IF (AVD - 0.7853981638D+00) 10100, 10100, 20100 02410824
10100 IVPASS = IVPASS + 1 02420824
WRITE (NUVI, 80002) IVTNUM 02430824
GO TO 0101 02440824
20100 IVFAIL = IVFAIL + 1 02450824
DVCORR = 0.78539816339744830962D+00 02460824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02470824
0101 CONTINUE 02480824
CT011* TEST 11 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO 02490824
IVTNUM = 11 02500824
AVD = DATAN2(1.2D0, 0.0D0) 02510824
IF (AVD - 0.1570796326D+01) 20110, 10110, 40110 02520824
40110 IF (AVD - 0.1570796328D+01) 10110, 10110, 20110 02530824
10110 IVPASS = IVPASS + 1 02540824
WRITE (NUVI, 80002) IVTNUM 02550824
GO TO 0111 02560824
20110 IVFAIL = IVFAIL + 1 02570824
DVCORR = 1.5707963267948966192D+00 02580824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02590824
0111 CONTINUE 02600824
CT012* TEST 12 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO 02610824
IVTNUM = 12 02620824
BVD = -2.5D0 02630824
CVD = 0.0D0 02640824
AVD = DATAN2(BVD, CVD) 02650824
IF (AVD + 0.1570796328D+01) 20120, 10120, 40120 02660824
40120 IF (AVD + 0.1570796326D+01) 10120, 10120, 20120 02670824
10120 IVPASS = IVPASS + 1 02680824
WRITE (NUVI, 80002) IVTNUM 02690824
GO TO 0121 02700824
20120 IVFAIL = IVFAIL + 1 02710824
DVCORR = -1.5707963267948966192D+00 02720824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02730824
0121 CONTINUE 02740824
CT013* TEST 13 COMPARISON OF DATAN AND DATAN2 02750824
IVTNUM = 13 02760824
AVD = (DATAN(DSQRT(3.0D0) / 3.0D0) * 2.0D0) + 02770824
1 DATAN2(-DSQRT(3.0D0) / 2.0D0, 1.0D0 / 2.0D0) 02780824
IF (AVD + 0.5000000000D-09) 20130, 10130, 40130 02790824
40130 IF (AVD - 0.5000000000D-09) 10130, 10130, 20130 02800824
10130 IVPASS = IVPASS + 1 02810824
WRITE (NUVI, 80002) IVTNUM 02820824
GO TO 0131 02830824
20130 IVFAIL = IVFAIL + 1 02840824
DVCORR = 0.00000000000000000000D+00 02850824
WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02860824
0131 CONTINUE 02870824
C***** 02880824
CBB** ********************** BBCSUM0 **********************************02890824
C**** WRITE OUT TEST SUMMARY 02900824
C**** 02910824
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02920824
WRITE (I02, 90004) 02930824
WRITE (I02, 90014) 02940824
WRITE (I02, 90004) 02950824
WRITE (I02, 90020) IVPASS 02960824
WRITE (I02, 90022) IVFAIL 02970824
WRITE (I02, 90024) IVDELE 02980824
WRITE (I02, 90026) IVINSP 02990824
WRITE (I02, 90028) IVTOTN, IVTOTL 03000824
CBE** ********************** BBCSUM0 **********************************03010824
CBB** ********************** BBCFOOT0 **********************************03020824
C**** WRITE OUT REPORT FOOTINGS 03030824
C**** 03040824
WRITE (I02,90016) ZPROG, ZPROG 03050824
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03060824
WRITE (I02,90019) 03070824
CBE** ********************** BBCFOOT0 **********************************03080824
CBB** ********************** BBCFMT0A **********************************03090824
C**** FORMATS FOR TEST DETAIL LINES 03100824
C**** 03110824
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03120824
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03130824
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03140824
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03150824
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03160824
1I6,/," ",15X,"CORRECT= " ,I6) 03170824
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03180824
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03190824
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03200824
1A21,/," ",16X,"CORRECT= " ,A21) 03210824
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03220824
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03230824
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03240824
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03250824
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03260824
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03270824
80050 FORMAT (" ",48X,A31) 03280824
CBE** ********************** BBCFMT0A **********************************03290824
CBB** ********************** BBCFMAT1 **********************************03300824
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03310824
C**** 03320824
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330824
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03340824
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03350824
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03360824
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03370824
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03380824
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03390824
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03400824
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03410824
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03420824
2"(",F12.5,", ",F12.5,")") 03430824
CBE** ********************** BBCFMAT1 **********************************03440824
CBB** ********************** BBCFMT0B **********************************03450824
C**** FORMAT STATEMENTS FOR PAGE HEADERS 03460824
C**** 03470824
90002 FORMAT ("1") 03480824
90004 FORMAT (" ") 03490824
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03500824
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03510824
90008 FORMAT (" ",21X,A13,A17) 03520824
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03530824
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03540824
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03550824
1 7X,"REMARKS",24X) 03560824
90014 FORMAT (" ","----------------------------------------------" , 03570824
1 "---------------------------------" ) 03580824
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03590824
C**** 03600824
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03610824
C**** 03620824
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03630824
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03640824
1 A13) 03650824
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03660824
C**** 03670824
C**** FORMAT STATEMENTS FOR RUN SUMMARY 03680824
C**** 03690824
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03700824
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03710824
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03720824
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03730824
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03740824
CBE** ********************** BBCFMT0B **********************************03750824
C***** 03760824
C***** END OF TEST SEGMENT 196 03770824
STOP 03780824
END 03790824
03800824