      PROGRAM FM828

C***********************************************************************00010828
C*****  FORTRAN 77                                                      00020828
C*****   FM828                                                          00030828
C*****                       YCFOR - (203)                              00040828
C*****                                                                  00050828
C***********************************************************************00060828
C*****  GENERAL PURPOSE                                         ANS REF 00070828
C*****    TEST COMPLEX TRIGONOMETRIC FORMULAE                   15.3    00080828
C*****                                                          TABLE 5 00090828
CBB** ********************** BBCCOMNT **********************************00100828
C****                                                                   00110828
C****            1978 FORTRAN COMPILER VALIDATION SYSTEM                00120828
C****                          VERSION 2.1                              00130828
C****                                                                   00140828
C****                                                                   00150828
C****           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO         00160828
C****          NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00170828
C****               SOFTWARE STANDARDS VALIDATION GROUP                 00180828
C****                      BUILDING 225  RM A266                        00190828
C****                     GAITHERSBURG, MD  20899                       00200828
C****                                                                   00210828
C****                                                                   00220828
C****                                                                   00230828
CBE** ********************** BBCCOMNT **********************************00240828
C*****                                                                  00250828
C*****  S P E C I F I C A T I O N S  SEGMENT 203                        00260828
        COMPLEX AVC, BVC, CVC, DVC, ZVCORR                              00270828
        REAL R2E(2)                                                     00280828
        EQUIVALENCE (AVC, R2E)                                          00290828
C*****                                                                  00300828
CBB** ********************** BBCINITA **********************************00310828
C**** SPECIFICATION STATEMENTS                                          00320828
C****                                                                   00330828
      CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20,      00340828
     1          ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13      00350828
CBE** ********************** BBCINITA **********************************00360828
CBB** ********************** BBCINITB **********************************00370828
C**** INITIALIZE SECTION                                                00380828
      DATA  ZVERS,                  ZVERSD,             ZDATE           00390828
     1      /'VERSION 2.1  ',  '93/10/21*21.02.00',  '*NO DATE*TIME'/   00400828
      DATA       ZCOMPL,             ZNAME,             ZTAPE           00410828
     1      /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/      00420828
      DATA       ZPROJ,           ZTAPED,         ZPROG                 00430828
     1      /'*NO PROJECT*',   '*NO TAPE DATE',  'XXXXX'/               00440828
      DATA   REMRKS /'                               '/                 00450828
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED   00460828
C**** FOR IDENTIFYING THE TEST ENVIRONMENT                              00470828
C****                                                                   00480828
CZ01  ZVERS  = 'VERSION OF THE COMPILER VALIDATION SYSTEM'              00490828
CZ02  ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM'   00500828
CZ03  ZPROG  = 'PROGRAM NAME'                                           00510828
CZ04  ZDATE  = 'DATE OF TEST'                                           00520828
CZ05  ZCOMPL = 'COMPILER IDENTIFICATION'                                00530828
CZ06  ZPROJ  = 'PROJECT NUMBER/IDENTIFICATION'                          00540828
CZ07  ZNAME  = 'NAME OF USER'                                           00550828
CZ08  ZTAPE  = 'TAPE OWNER/ID'                                          00560828
CZ09  ZTAPED = 'DATE TAPE COPIED'                                       00570828
C                                                                       00580828
      IVPASS = 0                                                        00590828
      IVFAIL = 0                                                        00600828
      IVDELE = 0                                                        00610828
      IVINSP = 0                                                        00620828
      IVTOTL = 0                                                        00630828
      IVTOTN = 0                                                        00640828
      ICZERO = 0                                                        00650828
C                                                                       00660828
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00670828
      I01 = 05                                                          00680828
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00690828
      I02 = 06                                                          00700828
C                                                                       00710828
CX010   REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00720828
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00730828
CX011   REPLACED BY FEXEC X-011 CONTROL CARD.  CX011 IS FOR SYSTEMS     00740828
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010.  00750828
C                                                                       00760828
CX020   REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER).     00770828
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6       00780828
CX021   REPLACED BY FEXEC X-021 CONTROL CARD.  CX021 IS FOR SYSTEMS     00790828
C     REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020.  00800828
C                                                                       00810828
CBE** ********************** BBCINITB **********************************00820828
      NUVI = I02                                                        00830828
      IVTOTL = 9                                                        00840828
      ZPROG = 'FM828'                                                   00850828
CBB** ********************** BBCHED0A **********************************00860828
C****                                                                   00870828
C**** WRITE REPORT TITLE                                                00880828
C****                                                                   00890828
      WRITE (I02, 90002)                                                00900828
      WRITE (I02, 90006)                                                00910828
      WRITE (I02, 90007)                                                00920828
      WRITE (I02, 90008)  ZVERS, ZVERSD                                 00930828
      WRITE (I02, 90009)  ZPROG, ZPROG                                  00940828
      WRITE (I02, 90010)  ZDATE, ZCOMPL                                 00950828
CBE** ********************** BBCHED0A **********************************00960828
C*****                                                                  00970828
C*****    HEADER FOR SEGMENT 203                                        00980828
        WRITE(NUVI,20300)                                               00990828
20300   FORMAT(" ", / "  YCFOR - (203) INTRINSIC FUNCTIONS" //          01000828
     1         "  COMPLEX TRIGONOMETRIC FORMULAE" //                    01010828
     2         "  ANS REF. - 15.3" )                                    01020828
CBB** ********************** BBCHED0B **********************************01030828
C**** WRITE DETAIL REPORT HEADERS                                       01040828
C****                                                                   01050828
      WRITE (I02,90004)                                                 01060828
      WRITE (I02,90004)                                                 01070828
      WRITE (I02,90013)                                                 01080828
      WRITE (I02,90014)                                                 01090828
      WRITE (I02,90015) IVTOTL                                          01100828
CBE** ********************** BBCHED0B **********************************01110828
C*****                                                                  01120828
        PIVS = 3.1415926535897932384626434                              01130828
C*****                                                                  01140828
CT001*  TEST 1                                           SQRT(Z)**2 = Z 01150828
           IVTNUM = 1                                                   01160828
        BVC = (1.0, 0.0) + (0.0, -2.5)                                  01170828
        AVC = CSQRT((1.0, -2.5)) ** 2 - BVC                             01180828
           IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011                01190828
40011      IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010                01200828
40012      IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010                01210828
40010      IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010                01220828
10010      IVPASS = IVPASS + 1                                          01230828
           WRITE (NUVI, 80002) IVTNUM                                   01240828
           GO TO 0011                                                   01250828
20010      IVFAIL = IVFAIL + 1                                          01260828
           ZVCORR = (0.0000, 0.0000)                                    01270828
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      01280828
 0011      CONTINUE                                                     01290828
CT002*  TEST 2   ANGLE SUBTENDED BY SQRT(Z) IS 1/2 ANGLE SUBTENDED BY Z 01300828
           IVTNUM = 2                                                   01310828
        BVC = CSQRT((2.0, 3.25))                                        01320828
        CVS = AIMAG(BVC)                                                01330828
        DVS = CABS((BVC + CONJG(BVC)) / (2.0, 0.0))                     01340828
        AVS = ATAN2(3.0 + 0.25, 1.0 * 2.0) - 2.0 * ATAN2(CVS, DVS)      01350828
           IF (AVS + 0.50000E-04) 20020, 10020, 40020                   01360828
40020      IF (AVS - 0.50000E-04) 10020, 10020, 20020                   01370828
10020      IVPASS = IVPASS + 1                                          01380828
           WRITE (NUVI, 80002) IVTNUM                                   01390828
           GO TO 0021                                                   01400828
20020      IVFAIL = IVFAIL + 1                                          01410828
           RVCORR = 0.0000                                              01420828
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01430828
 0021      CONTINUE                                                     01440828
CT003*  TEST 3                                          EXP(LOG(Z)) = Z 01450828
           IVTNUM = 3                                                   01460828
        BVC = (0.0, 0.0) - (1.5, 0.75)                                  01470828
        AVC = CEXP(CLOG(BVC)) + (1.5, 0.75)                             01480828
           IF (R2E(1) + 0.50000E-04) 20030, 40032, 40031                01490828
40031      IF (R2E(1) - 0.50000E-04) 40032, 40032, 20030                01500828
40032      IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030                01510828
40030      IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030                01520828
10030      IVPASS = IVPASS + 1                                          01530828
           WRITE (NUVI, 80002) IVTNUM                                   01540828
           GO TO 0031                                                   01550828
20030      IVFAIL = IVFAIL + 1                                          01560828
           ZVCORR = (0.0000, 0.0000)                                    01570828
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      01580828
 0031      CONTINUE                                                     01590828
CT004*  TEST 4                               ABS(EXP(Z)) = EXP(REAL(Z)) 01600828
           IVTNUM = 4                                                   01610828
        AVS = CABS(CEXP((-2.5, 1.375))) - EXP(5.0 / (-2.0))             01620828
           IF (AVS + 0.50000E-04) 20040, 10040, 40040                   01630828
40040      IF (AVS - 0.50000E-04) 10040, 10040, 20040                   01640828
10040      IVPASS = IVPASS + 1                                          01650828
           WRITE (NUVI, 80002) IVTNUM                                   01660828
           GO TO 0041                                                   01670828
20040      IVFAIL = IVFAIL + 1                                          01680828
           RVCORR = 0.0000                                              01690828
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01700828
 0041      CONTINUE                                                     01710828
CT005*  TEST 5            ANGLE SUBTENDED BY EXP(Z) IS IMAG(Z) MOD 2 PI 01720828
           IVTNUM = 5                                                   01730828
        BVC = (0.0625, 0.0)                                             01740828
        CVC = CEXP(BVC + (0.0, 1.125))                                  01750828
        DVS = ATAN2(AIMAG(CVC), CABS((CVC + CONJG(CVC)) / (2.0, 0.0)))  01760828
        AVS = DVS - AMOD(AIMAG((0.0625, 1.125)), 2.0 * PIVS)            01770828
           IF (AVS + 0.50000E-04) 20050, 10050, 40050                   01780828
40050      IF (AVS - 0.50000E-04) 10050, 10050, 20050                   01790828
10050      IVPASS = IVPASS + 1                                          01800828
           WRITE (NUVI, 80002) IVTNUM                                   01810828
           GO TO 0051                                                   01820828
20050      IVFAIL = IVFAIL + 1                                          01830828
           RVCORR = 0.0000                                              01840828
           WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR                      01850828
 0051      CONTINUE                                                     01860828
CT006*  TEST 6                              EXP(IY) = COS(Y) + I SIN(Y) 01870828
           IVTNUM = 6                                                   01880828
        AVC = CEXP(CMPLX(0.0, 37.5 / 10.0))                             01890828
     1        - CMPLX(COS(3.75), SIN(2.75 + 1.0))                       01900828
           IF (R2E(1) + 0.50000E-04) 20060, 40062, 40061                01910828
40061      IF (R2E(1) - 0.50000E-04) 40062, 40062, 20060                01920828
40062      IF (R2E(2) + 0.50000E-04) 20060, 10060, 40060                01930828
40060      IF (R2E(2) - 0.50000E-04) 10060, 10060, 20060                01940828
10060      IVPASS = IVPASS + 1                                          01950828
           WRITE (NUVI, 80002) IVTNUM                                   01960828
           GO TO 0061                                                   01970828
20060      IVFAIL = IVFAIL + 1                                          01980828
           ZVCORR = (0.0000, 0.0000)                                    01990828
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      02000828
 0061      CONTINUE                                                     02010828
CT007*  TEST 7                    COS(Z) = 0.5 * (EXP(I*Z) + EXP(-I*Z)) 02020828
           IVTNUM = 7                                                   02030828
         BVC = CEXP((-1.5, -2.75))                                      02040828
         CVC = (BVC + 1 / BVC) / (2.0, 0.0)                             02050828
         DVC = (2.75, -1.5)                                             02060828
         AVC = CVC - CCOS(DVC * (-1.0, 0.0))                            02070828
            IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071               02080828
40071       IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070               02090828
40072       IF (R2E(2) + 0.50000E-04) 20070, 10070, 40070               02100828
40070       IF (R2E(2) - 0.50000E-04) 10070, 10070, 20070               02110828
10070       IVPASS = IVPASS + 1                                         02120828
            WRITE (NUVI, 80002) IVTNUM                                  02130828
            GO TO 0071                                                  02140828
20070       IVFAIL = IVFAIL + 1                                         02150828
            ZVCORR = (0.0000, 0.0000)                                   02160828
            WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                     02170828
 0071       CONTINUE                                                    02180828
CT008*  TEST 8                                       ABS(EXP(IY)) = 1.0 02190828
           IVTNUM = 8                                                   02200828
        BVC = (3.25, 3.25)                                              02210828
        CVC = (3.25, 0.0)                                               02220828
        AVC = CABS(CEXP(BVC - CVC)) - COS(0.0)                          02230828
           IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081                02240828
40081      IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080                02250828
40082      IF (R2E(2) + 0.50000E-04) 20080, 10080, 40080                02260828
40080      IF (R2E(2) - 0.50000E-04) 10080, 10080, 20080                02270828
10080      IVPASS = IVPASS + 1                                          02280828
           WRITE (NUVI, 80002) IVTNUM                                   02290828
           GO TO 0081                                                   02300828
20080      IVFAIL = IVFAIL + 1                                          02310828
           ZVCORR = (0.0000, 0.0000)                                    02320828
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      02330828
 0081      CONTINUE                                                     02340828
CT009*  TEST 9                               DEMOIVRE THEOREM FOR N = 3 02350828
           IVTNUM = 9                                                   02360828
        BVS = 3.0/2.0                                                   02370828
        BVC = CMPLX(COS(1.5), SIN(BVS)) ** 3                            02380828
        AVC = BVC - CMPLX(COS(4.5), -SIN(4.5 + PIVS))                   02390828
           IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091                02400828
40091      IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090                02410828
40092      IF (R2E(2) + 0.50000E-04) 20090, 10090, 40090                02420828
40090      IF (R2E(2) - 0.50000E-04) 10090, 10090, 20090                02430828
10090      IVPASS = IVPASS + 1                                          02440828
           WRITE (NUVI, 80002) IVTNUM                                   02450828
           GO TO 0091                                                   02460828
20090      IVFAIL = IVFAIL + 1                                          02470828
           ZVCORR = (0.0000, 0.0000)                                    02480828
           WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR                      02490828
 0091      CONTINUE                                                     02500828
C*****                                                                  02510828
CBB** ********************** BBCSUM0  **********************************02520828
C**** WRITE OUT TEST SUMMARY                                            02530828
C****                                                                   02540828
      IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP                        02550828
      WRITE (I02, 90004)                                                02560828
      WRITE (I02, 90014)                                                02570828
      WRITE (I02, 90004)                                                02580828
      WRITE (I02, 90020) IVPASS                                         02590828
      WRITE (I02, 90022) IVFAIL                                         02600828
      WRITE (I02, 90024) IVDELE                                         02610828
      WRITE (I02, 90026) IVINSP                                         02620828
      WRITE (I02, 90028) IVTOTN, IVTOTL                                 02630828
CBE** ********************** BBCSUM0  **********************************02640828
CBB** ********************** BBCFOOT0 **********************************02650828
C**** WRITE OUT REPORT FOOTINGS                                         02660828
C****                                                                   02670828
      WRITE (I02,90016) ZPROG, ZPROG                                    02680828
      WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED                     02690828
      WRITE (I02,90019)                                                 02700828
CBE** ********************** BBCFOOT0 **********************************02710828
CBB** ********************** BBCFMT0A **********************************02720828
C**** FORMATS FOR TEST DETAIL LINES                                     02730828
C****                                                                   02740828
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31)                           02750828
80002 FORMAT (" ",2X,I3,4X," PASS  ",32X,A31)                           02760828
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31)                           02770828
80008 FORMAT (" ",2X,I3,4X," FAIL  ",32X,A31)                           02780828
80010 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",15X,"COMPUTED= " ,           02790828
     1I6,/," ",15X,"CORRECT=  " ,I6)                                    02800828
80012 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02810828
     1E12.5,/," ",16X,"CORRECT=  " ,E12.5)                              02820828
80018 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02830828
     1A21,/," ",16X,"CORRECT=  " ,A21)                                  02840828
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31)                         02850828
80022 FORMAT (" ",16X,"CORRECT=  " ,A21,1X,A31)                         02860828
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31)                         02870828
80026 FORMAT (" ",16X,"CORRECT=  " ,I6,16X,A31)                         02880828
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31)                      02890828
80030 FORMAT (" ",16X,"CORRECT=  " ,E12.5,10X,A31)                      02900828
80050 FORMAT (" ",48X,A31)                                              02910828
CBE** ********************** BBCFMT0A **********************************02920828
CBB** ********************** BBCFMAT1 **********************************02930828
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE                     02940828
C****                                                                   02950828
80031 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           02960828
     1D17.10,/," ",16X,"CORRECT=  " ,D17.10)                            02970828
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31)                     02980828
80035 FORMAT (" ",16X,"CORRECT=  " ,D17.10,10X,A31)                     02990828
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31)    03000828
80039 FORMAT (" ",16X,"CORRECT=  " ,"(",E12.5,", ",E12.5,")",6X,A31)    03010828
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31)    03020828
80043 FORMAT (" ",16X,"CORRECT=  " ,"(",F12.5,", ",F12.5,")",6X,A31)    03030828
80045 FORMAT (" ",2X,I3,4X," FAIL  ",/," ",16X,"COMPUTED= " ,           03040828
     1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT=  " ,                  03050828
     2"(",F12.5,", ",F12.5,")")                                         03060828
CBE** ********************** BBCFMAT1 **********************************03070828
CBB** ********************** BBCFMT0B **********************************03080828
C**** FORMAT STATEMENTS FOR PAGE HEADERS                                03090828
C****                                                                   03100828
90002 FORMAT ("1")                                                      03110828
90004 FORMAT (" ")                                                      03120828
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03130828
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" )            03140828
90008 FORMAT (" ",21X,A13,A17)                                          03150828
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/)       03160828
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17,"  -  COMPILER= " ,A20)    03170828
90013 FORMAT (" "," TEST   ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" ,     03180828
     1       7X,"REMARKS",24X)                                          03190828
90014 FORMAT (" ","----------------------------------------------" ,    03200828
     1        "---------------------------------" )                     03210828
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/)               03220828
C****                                                                   03230828
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS                             03240828
C****                                                                   03250828
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/)          03260828
90018 FORMAT (" ",A13,13X,A20,"   *   ",A10,"/",                        03270828
     1        A13)                                                      03280828
90019 FORMAT (" ","FOR OFFICIAL USE ONLY     " ,35X,"COPYRIGHT  1982" ) 03290828
C****                                                                   03300828
C**** FORMAT STATEMENTS FOR RUN SUMMARY                                 03310828
C****                                                                   03320828
90020 FORMAT (" ",21X,I5," TESTS PASSED" )                              03330828
90022 FORMAT (" ",21X,I5," TESTS FAILED" )                              03340828
90024 FORMAT (" ",21X,I5," TESTS DELETED" )                             03350828
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" )                  03360828
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" )                  03370828
CBE** ********************** BBCFMT0B **********************************03380828
C*****                                                                  03390828
C*****    END OF TEST SEGMENT 203                                       03400828
      STOP                                                              03410828
      END                                                               03420828
                                                                        03430828