      PROGRAM FM307                                                     00010307
C                                                                       00020307
C                                                                       00030307
C          THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION    00040307
C     TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL.  THE   00050307
C     FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE.   00060307
C     THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND   00070307
C     UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES.  EACH     00080307
C     INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT         00090307
C     COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE    00100307
C     VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF 00110307
C     ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE.  THE     00120307
C     INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE.               00130307
C                                                                       00140307
C                                        SPECIFIC        TYPE  OF       00150307
C          INTRINSIC FUNCTION            NAME        ARGUMENT   FUNCTION00160307
C          ------------------            ------      --------   --------00170307
C          CONVERSION TO REAL            REAL        INTEGER    REAL    00180307
C          NEAREST WHOLE NUMBER          ANINT       REAL       REAL    00190307
C          NEAREST INTEGER               NINT        REAL       INTEGER 00200307
C          TANGENT                       TAN         REAL       REAL    00210307
C          ARCSINE                       ASIN        REAL       REAL    00220307
C          ARCCOSINE                     ACOS        REAL       REAL    00230307
C          HYPERBOLIC SINE               SINH        REAL       REAL    00240307
C          HYPERBOLIC COSINE             COSH        REAL       REAL    00250307
C                                                                       00260307
C          SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO     00270307
C     TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS.             00280307
C                                                                       00290307
C     REFERENCES.                                                       00300307
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00310307
C           X3.9-1978                                                   00320307
C                                                                       00330307
C        SECTION 15.3,     INTRINSIC FUNCTIONS                          00340307
C        SECTION 15.9.2,   ACTUAL ARGUMENTS                             00350307
C        SECTION 15.9.3,   ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS    00360307
C        TABLE 5,          INTRINSIC FUNCTIONS (INCLUDING NOTES)        00370307
C        SECTION 15.10.1,  RESTRICTION ON RANGE OF ARGUMENTS AND RESULTS00380307
C                                                                       00390307
C                                                                       00400307
C     ******************************************************************00410307
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00420307
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN   00430307
C     X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY.  THE 00440307
C     FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT       00450307
C     ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT00460307
C     ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS   00470307
C     OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00480307
C     THE RESULT OF EXECUTING THESE TESTS.                              00490307
C                                                                       00500307
C     THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES      00510307
C     FOUND IN THE SUBSET LEVEL OF THE STANDARD.                        00520307
C                                                                       00530307
C           SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO             00540307
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00550307
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00560307
C                          BUILDING 225  RM A266                        00570307
C                         GAITHERSBURG, MD  20899                       00580307
C     ******************************************************************00590307
C                                                                       00600307
C                                                                       00610307
      IMPLICIT LOGICAL (L)                                              00620307
      IMPLICIT CHARACTER*14 (C)                                         00630307
C                                                                       00640307
      DIMENSION IAON11(4)                                               00650307
      DIMENSION RAON11(4)                                               00660307
      DATA PI/3.141592654/                                              00670307
C                                                                       00680307
C                                                                       00690307
C                                                                       00700307
C     INITIALIZATION SECTION.                                           00710307
C                                                                       00720307
C     INITIALIZE CONSTANTS                                              00730307
C     ********************                                              00740307
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER          00750307
      I01 = 5                                                           00760307
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER              00770307
      I02 = 6                                                           00780307
C     SYSTEM ENVIRONMENT SECTION                                        00790307
C                                                                       00800307
CX010     THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00810307
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00820307
C     (UNIT NUMBER FOR CARD READER).                                    00830307
CX011      THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00840307
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00850307
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00860307
C                                                                       00870307
CX020     THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00880307
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00890307
C     (UNIT NUMBER FOR PRINTER).                                        00900307
CX021     THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00910307
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00920307
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00930307
C                                                                       00940307
      IVPASS = 0                                                        00950307
      IVFAIL = 0                                                        00960307
      IVDELE = 0                                                        00970307
      ICZERO = 0                                                        00980307
C                                                                       00990307
C     WRITE OUT PAGE HEADERS                                            01000307
C                                                                       01010307
      WRITE (I02,90002)                                                 01020307
      WRITE (I02,90006)                                                 01030307
      WRITE (I02,90008)                                                 01040307
      WRITE (I02,90004)                                                 01050307
      WRITE (I02,90010)                                                 01060307
      WRITE (I02,90004)                                                 01070307
      WRITE (I02,90016)                                                 01080307
      WRITE (I02,90001)                                                 01090307
      WRITE (I02,90004)                                                 01100307
      WRITE (I02,90012)                                                 01110307
      WRITE (I02,90014)                                                 01120307
      WRITE (I02,90004)                                                 01130307
C                                                                       01140307
C                                                                       01150307
C     TEST 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR    01160307
C     TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE 01170307
C     ARGUMENT IS INTEGER.                                              01180307
C                                                                       01190307
C                                                                       01200307
C     ****  FCVS PROGRAM 307  -  TEST 001  ****                         01210307
C                                                                       01220307
C     CONSTANT ARGUMENT                                                 01230307
C                                                                       01240307
      IVTNUM =   1                                                      01250307
      IF (ICZERO) 30010, 0010, 30010                                    01260307
 0010 CONTINUE                                                          01270307
      RVCOMP = 10.0                                                     01280307
      RVCOMP = REAL (6)                                                 01290307
      RVCORR = 6.0                                                      01300307
40010 IF (RVCOMP - 5.9995) 20010,10010,40011                            01310307
40011 IF (RVCOMP - 6.0005) 10010,10010,20010                            01320307
30010 IVDELE = IVDELE + 1                                               01330307
      WRITE (I02,80000) IVTNUM                                          01340307
      IF (ICZERO) 10010, 0021, 20010                                    01350307
10010 IVPASS = IVPASS + 1                                               01360307
      WRITE (I02,80002) IVTNUM                                          01370307
      GO TO 0021                                                        01380307
20010 IVFAIL = IVFAIL + 1                                               01390307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          01400307
 0021 CONTINUE                                                          01410307
C                                                                       01420307
C     ****  FCVS PROGRAM 307  -  TEST 002  ****                         01430307
C                                                                       01440307
C     VARIABLE ARGUMENT                                                 01450307
C                                                                       01460307
      IVTNUM =   2                                                      01470307
      IF (ICZERO) 30020, 0020, 30020                                    01480307
 0020 CONTINUE                                                          01490307
      RVCOMP = 10.0                                                     01500307
      IVON01 = 6                                                        01510307
      RVCOMP = REAL (IVON01)                                            01520307
      RVCORR = 6.0                                                      01530307
40020 IF (RVCOMP - 5.9995) 20020,10020,40021                            01540307
40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020                          01550307
30020 IVDELE = IVDELE + 1                                               01560307
      WRITE (I02,80000) IVTNUM                                          01570307
      IF (ICZERO) 10020, 0031, 20020                                    01580307
10020 IVPASS = IVPASS + 1                                               01590307
      WRITE (I02,80002) IVTNUM                                          01600307
      GO TO 0031                                                        01610307
20020 IVFAIL = IVFAIL + 1                                               01620307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          01630307
 0031 CONTINUE                                                          01640307
C                                                                       01650307
C     ****  FCVS PROGRAM 307  -  TEST 003  ****                         01660307
C                                                                       01670307
C     ARRAY ELEMENT NAME ARGUMENT                                       01680307
C                                                                       01690307
      IVTNUM =   3                                                      01700307
      IF (ICZERO) 30030, 0030, 30030                                    01710307
 0030 CONTINUE                                                          01720307
      RVCOMP = 10.0                                                     01730307
      IAON11(3) = 6                                                     01740307
      RVCOMP = REAL (IAON11(3))                                         01750307
      RVCORR = 6.0                                                      01760307
40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031                          01770307
40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030                          01780307
30030 IVDELE = IVDELE + 1                                               01790307
      WRITE (I02,80000) IVTNUM                                          01800307
      IF (ICZERO) 10030, 0041, 20030                                    01810307
10030 IVPASS = IVPASS + 1                                               01820307
      WRITE (I02,80002) IVTNUM                                          01830307
      GO TO 0041                                                        01840307
20030 IVFAIL = IVFAIL + 1                                               01850307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          01860307
 0041 CONTINUE                                                          01870307
C                                                                       01880307
C     ****  FCVS PROGRAM 307  -  TEST 004  ****                         01890307
C                                                                       01900307
C     EXPRESSION AS ARGUMENT                                            01910307
C                                                                       01920307
      IVTNUM =   4                                                      01930307
      IF (ICZERO) 30040, 0040, 30040                                    01940307
 0040 CONTINUE                                                          01950307
      RVCOMP = 10.0                                                     01960307
      IVON01 = 6                                                        01970307
      RVCOMP = REAL (IVON01 - 6)                                        01980307
      RVCORR = 0.0                                                      01990307
40040 IF(RVCOMP + .00005) 20040, 10040, 40041                           02000307
40041 IF(RVCOMP - .00005) 10040, 10040, 20040                           02010307
30040 IVDELE = IVDELE + 1                                               02020307
      WRITE (I02,80000) IVTNUM                                          02030307
      IF (ICZERO) 10040, 0051, 20040                                    02040307
10040 IVPASS = IVPASS + 1                                               02050307
      WRITE (I02,80002) IVTNUM                                          02060307
      GO TO 0051                                                        02070307
20040 IVFAIL = IVFAIL + 1                                               02080307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          02090307
 0051 CONTINUE                                                          02100307
C                                                                       02110307
C     TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR    02120307
C     FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND   02130307
C     ARGUMENT TYPES ARE BOTH REAL.                                     02140307
C                                                                       02150307
C                                                                       02160307
C     ****  FCVS PROGRAM 307  -  TEST 005  ****                         02170307
C                                                                       02180307
C     CONSTANT ARGUMENT                                                 02190307
C                                                                       02200307
      IVTNUM =   5                                                      02210307
      IF (ICZERO) 30050, 0050, 30050                                    02220307
 0050 CONTINUE                                                          02230307
      RVCOMP = 10.0                                                     02240307
      RVCOMP = ANINT (3.4994)                                           02250307
      RVCORR = 3.0                                                      02260307
40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051                          02270307
40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050                          02280307
30050 IVDELE = IVDELE + 1                                               02290307
      WRITE (I02,80000) IVTNUM                                          02300307
      IF (ICZERO) 10050, 0061, 20050                                    02310307
10050 IVPASS = IVPASS + 1                                               02320307
      WRITE (I02,80002) IVTNUM                                          02330307
      GO TO 0061                                                        02340307
20050 IVFAIL = IVFAIL + 1                                               02350307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          02360307
 0061 CONTINUE                                                          02370307
C                                                                       02380307
C     ****  FCVS PROGRAM 307  -  TEST 006  ****                         02390307
C                                                                       02400307
C     VARIABLE ARGUMENT                                                 02410307
C                                                                       02420307
      IVTNUM =   6                                                      02430307
      IF (ICZERO) 30060, 0060, 30060                                    02440307
 0060 CONTINUE                                                          02450307
      RVCOMP = 10.0                                                     02460307
      RVON01 = -3.4994                                                  02470307
      RVCOMP = ANINT (RVON01)                                           02480307
      RVCORR = -3.0                                                     02490307
40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061                          02500307
40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060                          02510307
30060 IVDELE = IVDELE + 1                                               02520307
      WRITE (I02,80000) IVTNUM                                          02530307
      IF (ICZERO) 10060, 0071, 20060                                    02540307
10060 IVPASS = IVPASS + 1                                               02550307
      WRITE (I02,80002) IVTNUM                                          02560307
      GO TO 0071                                                        02570307
20060 IVFAIL = IVFAIL + 1                                               02580307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          02590307
 0071 CONTINUE                                                          02600307
C                                                                       02610307
C     ****  FCVS PROGRAM 307  -  TEST 007  ****                         02620307
C                                                                       02630307
C     ARRAY ELEMENT NAME ARGUMENT                                       02640307
C                                                                       02650307
      IVTNUM =   7                                                      02660307
      IF (ICZERO) 30070, 0070, 30070                                    02670307
 0070 CONTINUE                                                          02680307
      RVCOMP = 10.0                                                     02690307
      RAON11(3) = 3.0000                                                02700307
      RVCOMP = ANINT (RAON11(3))                                        02710307
      RVCORR = 3.0                                                      02720307
40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071                          02730307
40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070                          02740307
30070 IVDELE = IVDELE + 1                                               02750307
      WRITE (I02,80000) IVTNUM                                          02760307
      IF (ICZERO) 10070, 0081, 20070                                    02770307
10070 IVPASS = IVPASS + 1                                               02780307
      WRITE (I02,80002) IVTNUM                                          02790307
      GO TO 0081                                                        02800307
20070 IVFAIL = IVFAIL + 1                                               02810307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          02820307
 0081 CONTINUE                                                          02830307
C                                                                       02840307
C     ****  FCVS PROGRAM 307  -  TEST 008  ****                         02850307
C                                                                       02860307
C     ZERO ARGUMENT                                                     02870307
C                                                                       02880307
      IVTNUM =   8                                                      02890307
      IF (ICZERO) 30080, 0080, 30080                                    02900307
 0080 CONTINUE                                                          02910307
      RVCOMP = 10.0                                                     02920307
      RVCOMP = ANINT (0.0)                                              02930307
      RVCORR = 0.0                                                      02940307
40080 IF (RVCOMP) 20080, 10080, 20080                                   02950307
30080 IVDELE = IVDELE + 1                                               02960307
      WRITE (I02,80000) IVTNUM                                          02970307
      IF (ICZERO) 10080, 0091, 20080                                    02980307
10080 IVPASS = IVPASS + 1                                               02990307
      WRITE (I02,80002) IVTNUM                                          03000307
      GO TO 0091                                                        03010307
20080 IVFAIL = IVFAIL + 1                                               03020307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          03030307
 0091 CONTINUE                                                          03040307
C                                                                       03050307
C     TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR    03060307
C     FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL     03070307
C     AND THE FUNCTION TYPE IS INTEGER.                                 03080307
C                                                                       03090307
C                                                                       03100307
C     ****  FCVS PROGRAM 307  -  TEST 009  ****                         03110307
C                                                                       03120307
C     CONSTANT ARGUMENT                                                 03130307
C                                                                       03140307
      IVTNUM =   9                                                      03150307
      IF (ICZERO) 30090, 0090, 30090                                    03160307
 0090 CONTINUE                                                          03170307
      IVCOMP = 10                                                       03180307
      IVCOMP = NINT (3.4994)                                            03190307
      IVCORR = 3                                                        03200307
40090 IF (IVCOMP - 3) 20090, 10090, 20090                               03210307
30090 IVDELE = IVDELE + 1                                               03220307
      WRITE (I02,80000) IVTNUM                                          03230307
      IF (ICZERO) 10090, 0101, 20090                                    03240307
10090 IVPASS = IVPASS + 1                                               03250307
      WRITE (I02,80002) IVTNUM                                          03260307
      GO TO 0101                                                        03270307
20090 IVFAIL = IVFAIL + 1                                               03280307
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03290307
 0101 CONTINUE                                                          03300307
C                                                                       03310307
C     ****  FCVS PROGRAM 307  -  TEST 010  ****                         03320307
C                                                                       03330307
C     VARIABLE ARGUMENT                                                 03340307
C                                                                       03350307
      IVTNUM =  10                                                      03360307
      IF (ICZERO) 30100, 0100, 30100                                    03370307
 0100 CONTINUE                                                          03380307
      IVCOMP = 10                                                       03390307
      RVON01 = -3.4994                                                  03400307
      IVCOMP = NINT (RVON01)                                            03410307
      IVCORR = -3                                                       03420307
40100 IF (IVCOMP +3) 20100, 10100, 20100                                03430307
30100 IVDELE = IVDELE + 1                                               03440307
      WRITE (I02,80000) IVTNUM                                          03450307
      IF (ICZERO) 10100, 0111, 20100                                    03460307
10100 IVPASS = IVPASS + 1                                               03470307
      WRITE (I02,80002) IVTNUM                                          03480307
      GO TO 0111                                                        03490307
20100 IVFAIL = IVFAIL + 1                                               03500307
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03510307
 0111 CONTINUE                                                          03520307
C                                                                       03530307
C     ****  FCVS PROGRAM 307  -  TEST 011  ****                         03540307
C                                                                       03550307
C     ARRAY ELEMENT NAME ARGUMENT                                       03560307
C                                                                       03570307
      IVTNUM =  11                                                      03580307
      IF (ICZERO) 30110, 0110, 30110                                    03590307
 0110 CONTINUE                                                          03600307
      IVCOMP = 10                                                       03610307
      RAON11(1) = 3.0000                                                03620307
      IVCOMP = NINT (RAON11(1))                                         03630307
      IVCORR = 3                                                        03640307
40110 IF (IVCOMP -3) 20110, 10110, 20110                                03650307
30110 IVDELE = IVDELE + 1                                               03660307
      WRITE (I02,80000) IVTNUM                                          03670307
      IF (ICZERO) 10110, 0121, 20110                                    03680307
10110 IVPASS = IVPASS + 1                                               03690307
      WRITE (I02,80002) IVTNUM                                          03700307
      GO TO 0121                                                        03710307
20110 IVFAIL = IVFAIL + 1                                               03720307
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03730307
 0121 CONTINUE                                                          03740307
C                                                                       03750307
C     ****  FCVS PROGRAM 307  -  TEST 012  ****                         03760307
C                                                                       03770307
C     ZERO ARGUMENT                                                     03780307
C                                                                       03790307
      IVTNUM =  12                                                      03800307
      IF (ICZERO) 30120, 0120, 30120                                    03810307
 0120 CONTINUE                                                          03820307
      IVCOMP = 10                                                       03830307
      IVCOMP = NINT (0.0)                                               03840307
      IVCORR = 0                                                        03850307
40120 IF (IVCOMP) 20120, 10120, 20120                                   03860307
30120 IVDELE = IVDELE + 1                                               03870307
      WRITE (I02,80000) IVTNUM                                          03880307
      IF (ICZERO) 10120, 0131, 20120                                    03890307
10120 IVPASS = IVPASS + 1                                               03900307
      WRITE (I02,80002) IVTNUM                                          03910307
      GO TO 0131                                                        03920307
20120 IVFAIL = IVFAIL + 1                                               03930307
      WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR                          03940307
 0131 CONTINUE                                                          03950307
C                                                                       03960307
C     TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR    03970307
C     FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND    03980307
C     ARGUMENT TYPES ARE BOTH REAL.  ALL ARGUMENTS ARE GIVEN IN RADIANS 03990307
C     WHERE ONE RADIAN EQUALS 57.296 DEGREES.                           04000307
C                                                                       04010307
C                                                                       04020307
C     ****  FCVS PROGRAM 307  -  TEST 013  ****                         04030307
C                                                                       04040307
C     FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS)                       04050307
C                                                                       04060307
      IVTNUM =  13                                                      04070307
      IF (ICZERO) 30130, 0130, 30130                                    04080307
 0130 CONTINUE                                                          04090307
      RVCOMP = 10.0                                                     04100307
      RVCOMP = TAN (0.0)                                                04110307
      RVCORR = 0.0                                                      04120307
40130 IF (RVCOMP) 20130, 10130, 20130                                   04130307
30130 IVDELE = IVDELE + 1                                               04140307
      WRITE (I02,80000) IVTNUM                                          04150307
      IF (ICZERO) 10130, 0141, 20130                                    04160307
10130 IVPASS = IVPASS + 1                                               04170307
      WRITE (I02,80002) IVTNUM                                          04180307
      GO TO 0141                                                        04190307
20130 IVFAIL = IVFAIL + 1                                               04200307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          04210307
 0141 CONTINUE                                                          04220307
C                                                                       04230307
C     ****  FCVS PROGRAM 307  -  TEST 014  ****                         04240307
C                                                                       04250307
C     FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS)                  04260307
C                                                                       04270307
      IVTNUM =  14                                                      04280307
      IF (ICZERO) 30140, 0140, 30140                                    04290307
 0140 CONTINUE                                                          04300307
      RVCOMP = 10.0                                                     04310307
      RVON01 = 3 * PI / 4                                               04320307
      RVCOMP = TAN (RVON01)                                             04330307
      RVCORR = -1.0                                                     04340307
40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141                          04350307
40141 IF (RVCOMP + .9995) 10140, 10140, 20140                           04360307
30140 IVDELE = IVDELE + 1                                               04370307
      WRITE (I02,80000) IVTNUM                                          04380307
      IF (ICZERO) 10140, 0151, 20140                                    04390307
10140 IVPASS = IVPASS + 1                                               04400307
      WRITE (I02,80002) IVTNUM                                          04410307
      GO TO 0151                                                        04420307
20140 IVFAIL = IVFAIL + 1                                               04430307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          04440307
 0151 CONTINUE                                                          04450307
C                                                                       04460307
C     ****  FCVS PROGRAM 307  -  TEST 015  ****                         04470307
C                                                                       04480307
C     FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS)                  04490307
C                                                                       04500307
      IVTNUM =  15                                                      04510307
      IF (ICZERO) 30150, 0150, 30150                                    04520307
 0150 CONTINUE                                                          04530307
      RVCOMP = 10.0                                                     04540307
      RAON11(2) = 3 * PI                                                04550307
      RVCOMP = TAN (RAON11(2))                                          04560307
      RVCORR = 0.0                                                      04570307
40150 IF (RVCOMP + .00005) 20150, 10150, 40151                          04580307
40151 IF (RVCOMP - .00005) 10150, 10150, 20150                          04590307
30150 IVDELE = IVDELE + 1                                               04600307
      WRITE (I02,80000) IVTNUM                                          04610307
      IF (ICZERO) 10150, 0161, 20150                                    04620307
10150 IVPASS = IVPASS + 1                                               04630307
      WRITE (I02,80002) IVTNUM                                          04640307
      GO TO 0161                                                        04650307
20150 IVFAIL = IVFAIL + 1                                               04660307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          04670307
 0161 CONTINUE                                                          04680307
C                                                                       04690307
C     ****  FCVS PROGRAM 307  -  TEST 016  ****                         04700307
C                                                                       04710307
C     FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS)                   04720307
C                                                                       04730307
      IVTNUM =  16                                                      04740307
      IF (ICZERO) 30160, 0160, 30160                                    04750307
 0160 CONTINUE                                                          04760307
      RVCOMP = 10.0                                                     04770307
      RVON01 = PI/6                                                     04780307
      RVCOMP = TAN (RVON01)                                             04790307
      RVCORR = .57735                                                   04800307
40160 IF (RVCOMP - .57730) 20160, 10160, 40161                          04810307
40161 IF (RVCOMP - .57740) 10160, 10160, 20160                          04820307
30160 IVDELE = IVDELE + 1                                               04830307
      WRITE (I02,80000) IVTNUM                                          04840307
      IF (ICZERO) 10160, 0171, 20160                                    04850307
10160 IVPASS = IVPASS + 1                                               04860307
      WRITE (I02,80002) IVTNUM                                          04870307
      GO TO 0171                                                        04880307
20160 IVFAIL = IVFAIL + 1                                               04890307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          04900307
 0171 CONTINUE                                                          04910307
C                                                                       04920307
C     ****  FCVS PROGRAM 307  -  TEST 017  ****                         04930307
C                                                                       04940307
C     FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES 04950307
C     BY THE COSINE OF 30 DEGREES.                                      04960307
C                                                                       04970307
      IVTNUM =  17                                                      04980307
      IF (ICZERO) 30170, 0170, 30170                                    04990307
 0170 CONTINUE                                                          05000307
      RVCOMP = 10.0                                                     05010307
      RVON01 = PI/6                                                     05020307
      RVCOMP = SIN(RVON01)/COS(RVON01)                                  05030307
      RVCORR = .57735                                                   05040307
40170 IF (RVCOMP - .57730) 20170, 10170, 40171                          05050307
40171 IF (RVCOMP - .57740) 10170, 10170, 20170                          05060307
30170 IVDELE = IVDELE + 1                                               05070307
      WRITE (I02,80000) IVTNUM                                          05080307
      IF (ICZERO) 10170, 0181, 20170                                    05090307
10170 IVPASS = IVPASS + 1                                               05100307
      WRITE (I02,80002) IVTNUM                                          05110307
      GO TO 0181                                                        05120307
20170 IVFAIL = IVFAIL + 1                                               05130307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          05140307
 0181 CONTINUE                                                          05150307
C                                                                       05160307
C     TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR    05170307
C     FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND   05180307
C     ARGUMENT TYPES ARE BOTH REAL.  THE ABSOLUTE VALUES OF ALL         05190307
C     ARGUMENTS ARE LESS THAN OR EQUAL TO ONE.  THE FUNCTION VALUES     05200307
C     ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES.  05210307
C                                                                       05220307
C                                                                       05230307
C     ****  FCVS PROGRAM 307  -  TEST 018  ****                         05240307
C                                                                       05250307
C     THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS)                 05260307
C                                                                       05270307
      IVTNUM =  18                                                      05280307
      IF (ICZERO) 30180, 0180, 30180                                    05290307
 0180 CONTINUE                                                          05300307
      RVCOMP = 10.0                                                     05310307
      RVCOMP = ASIN (+1.0)                                              05320307
      RVCORR = 1.5708                                                   05330307
40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181                          05340307
40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180                          05350307
30180 IVDELE = IVDELE + 1                                               05360307
      WRITE (I02,80000) IVTNUM                                          05370307
      IF (ICZERO) 10180, 0191, 20180                                    05380307
10180 IVPASS = IVPASS + 1                                               05390307
      WRITE (I02,80002) IVTNUM                                          05400307
      GO TO 0191                                                        05410307
20180 IVFAIL = IVFAIL + 1                                               05420307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          05430307
 0191 CONTINUE                                                          05440307
C                                                                       05450307
C     ****  FCVS PROGRAM 307  -  TEST 019  ****                         05460307
C                                                                       05470307
C     THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS)               05480307
C                                                                       05490307
      IVTNUM =  19                                                      05500307
      IF (ICZERO) 30190, 0190, 30190                                    05510307
 0190 CONTINUE                                                          05520307
      RVCOMP = 10.0                                                     05530307
      RVON01 = -1.0                                                     05540307
      RVCOMP = ASIN(RVON01)                                             05550307
      RVCORR = -1.5708                                                  05560307
40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191                          05570307
40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190                          05580307
30190 IVDELE = IVDELE + 1                                               05590307
      WRITE (I02,80000) IVTNUM                                          05600307
      IF (ICZERO) 10190, 0201, 20190                                    05610307
10190 IVPASS = IVPASS + 1                                               05620307
      WRITE (I02,80002) IVTNUM                                          05630307
      GO TO 0201                                                        05640307
20190 IVFAIL = IVFAIL + 1                                               05650307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          05660307
 0201 CONTINUE                                                          05670307
C                                                                       05680307
C     ****  FCVS PROGRAM 307  -  TEST 020  ****                         05690307
C                                                                       05700307
C     THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS)               05710307
C                                                                       05720307
      IVTNUM =  20                                                      05730307
      IF (ICZERO) 30200, 0200, 30200                                    05740307
 0200 CONTINUE                                                          05750307
      RVCOMP = 10.0                                                     05760307
      RAON11(1) = -.5                                                   05770307
      RVCOMP = ASIN (RAON11(1))                                         05780307
      RVCORR = -.52360                                                  05790307
40200 IF (RVCOMP + .52365) 20200, 10200, 40201                          05800307
40201 IF (RVCOMP + .52355) 10200, 10200, 20200                          05810307
30200 IVDELE = IVDELE + 1                                               05820307
      WRITE (I02,80000) IVTNUM                                          05830307
      IF (ICZERO) 10200, 0211, 20200                                    05840307
10200 IVPASS = IVPASS + 1                                               05850307
      WRITE (I02,80002) IVTNUM                                          05860307
      GO TO 0211                                                        05870307
20200 IVFAIL = IVFAIL + 1                                               05880307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          05890307
 0211 CONTINUE                                                          05900307
C                                                                       05910307
C     ****  FCVS PROGRAM 307  -  TEST 021  ****                         05920307
C                                                                       05930307
C     THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS)                     05940307
C                                                                       05950307
      IVTNUM =  21                                                      05960307
      IF (ICZERO) 30210, 0210, 30210                                    05970307
 0210 CONTINUE                                                          05980307
      RVCOMP = 10.0                                                     05990307
      RVON01 = 0.0                                                      06000307
      RVCOMP = ASIN (RVON01)                                            06010307
      RVCORR = 0.0                                                      06020307
40210 IF (RVCOMP) 20210, 10210, 20210                                   06030307
30210 IVDELE = IVDELE + 1                                               06040307
      WRITE (I02,80000) IVTNUM                                          06050307
      IF (ICZERO) 10210, 0221, 20210                                    06060307
10210 IVPASS = IVPASS + 1                                               06070307
      WRITE (I02,80002) IVTNUM                                          06080307
      GO TO 0221                                                        06090307
20210 IVFAIL = IVFAIL + 1                                               06100307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06110307
 0221 CONTINUE                                                          06120307
C                                                                       06130307
C     TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR    06140307
C     FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION     06150307
C     AND ARGUMENT TYPES ARE BOTH REAL.  THE ABSOLUTE VALUES ALL        06160307
C     ARGUMENTS ARE LESS THAN OR EQUAL TO ONE.  THE FUNCTION VALUES     06170307
C     ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES.  06180307
C                                                                       06190307
C                                                                       06200307
C     ****  FCVS PROGRAM 307  -  TEST 022  ****                         06210307
C                                                                       06220307
C     THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS)                  06230307
C                                                                       06240307
      IVTNUM =  22                                                      06250307
      IF (ICZERO) 30220, 0220, 30220                                    06260307
 0220 CONTINUE                                                          06270307
      RVCOMP = 10.0                                                     06280307
      RVCOMP = ACOS(+1.)                                                06290307
      RVCORR = 0.0                                                      06300307
40220 IF (RVCOMP + .00005) 20220, 10220, 40221                          06310307
40221 IF (RVCOMP - .00005) 10220, 10220, 20220                          06320307
30220 IVDELE = IVDELE + 1                                               06330307
      WRITE (I02,80000) IVTNUM                                          06340307
      IF (ICZERO) 10220, 0231, 20220                                    06350307
10220 IVPASS = IVPASS + 1                                               06360307
      WRITE (I02,80002) IVTNUM                                          06370307
      GO TO 0231                                                        06380307
20220 IVFAIL = IVFAIL + 1                                               06390307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06400307
 0231 CONTINUE                                                          06410307
C                                                                       06420307
C     ****  FCVS PROGRAM 307  -  TEST 023  ****                         06430307
C                                                                       06440307
C     THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS)              06450307
C                                                                       06460307
      IVTNUM =  23                                                      06470307
      IF (ICZERO) 30230, 0230, 30230                                    06480307
 0230 CONTINUE                                                          06490307
      RVCOMP = 10.0                                                     06500307
      RVON01 = -1.0                                                     06510307
      RVCOMP = ACOS (RVON01)                                            06520307
      RVCORR = 3.1416                                                   06530307
40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231                          06540307
40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230                          06550307
30230 IVDELE = IVDELE + 1                                               06560307
      WRITE (I02,80000) IVTNUM                                          06570307
      IF (ICZERO) 10230, 0241, 20230                                    06580307
10230 IVPASS = IVPASS + 1                                               06590307
      WRITE (I02,80002) IVTNUM                                          06600307
      GO TO 0241                                                        06610307
20230 IVFAIL = IVFAIL + 1                                               06620307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06630307
 0241 CONTINUE                                                          06640307
C                                                                       06650307
C     ****  FCVS PROGRAM 307  -  TEST 024  ****                         06660307
C                                                                       06670307
C     THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS)              06680307
C                                                                       06690307
      IVTNUM =  24                                                      06700307
      IF (ICZERO) 30240, 0240, 30240                                    06710307
 0240 CONTINUE                                                          06720307
      RVCOMP = 10.0                                                     06730307
      RAON11(1) = -.5                                                   06740307
      RVCOMP = ACOS (RAON11(1))                                         06750307
      RVCORR = 2.0944                                                   06760307
40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241                          06770307
40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240                          06780307
30240 IVDELE = IVDELE + 1                                               06790307
      WRITE (I02,80000) IVTNUM                                          06800307
      IF (ICZERO) 10240, 0251, 20240                                    06810307
10240 IVPASS = IVPASS + 1                                               06820307
      WRITE (I02,80002) IVTNUM                                          06830307
      GO TO 0251                                                        06840307
20240 IVFAIL = IVFAIL + 1                                               06850307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          06860307
 0251 CONTINUE                                                          06870307
C                                                                       06880307
C     ****  FCVS PROGRAM 307  -  TEST 025  ****                         06890307
C                                                                       06900307
C     THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS)               06910307
C                                                                       06920307
      IVTNUM =  25                                                      06930307
      IF (ICZERO) 30250, 0250, 30250                                    06940307
 0250 CONTINUE                                                          06950307
      RVCOMP = 10.0                                                     06960307
      RVCOMP = ACOS (0.)                                                06970307
      RVCORR = 1.5708                                                   06980307
40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251                          06990307
40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250                          07000307
30250 IVDELE = IVDELE + 1                                               07010307
      WRITE (I02,80000) IVTNUM                                          07020307
      IF (ICZERO) 10250, 0261, 20250                                    07030307
10250 IVPASS = IVPASS + 1                                               07040307
      WRITE (I02,80002) IVTNUM                                          07050307
      GO TO 0261                                                        07060307
20250 IVFAIL = IVFAIL + 1                                               07070307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          07080307
 0261 CONTINUE                                                          07090307
C                                                                       07100307
C     TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR    07110307
C     FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND         07120307
C     ARGUMENT TYPES ARE BOTH REAL.  ONLY POSITIVE ARGUMENTS ARE        07130307
C     TESTED.                                                           07140307
C                                                                       07150307
C                                                                       07160307
C     ****  FCVS PROGRAM 307  -  TEST 026  ****                         07170307
C                                                                       07180307
C     CONSTANT ARGUMENT                                                 07190307
C                                                                       07200307
      IVTNUM =  26                                                      07210307
      IF (ICZERO) 30260, 0260, 30260                                    07220307
 0260 CONTINUE                                                          07230307
      RVCOMP = 10.0                                                     07240307
      RVCOMP = SINH (0.0)                                               07250307
      RVCORR = 0.0                                                      07260307
40260 IF (RVCOMP + .00005) 20260, 10260, 40261                          07270307
40261 IF (RVCOMP - .00005) 10260, 10260, 20260                          07280307
30260 IVDELE = IVDELE + 1                                               07290307
      WRITE (I02,80000) IVTNUM                                          07300307
      IF (ICZERO) 10260, 0271, 20260                                    07310307
10260 IVPASS = IVPASS + 1                                               07320307
      WRITE (I02,80002) IVTNUM                                          07330307
      GO TO 0271                                                        07340307
20260 IVFAIL = IVFAIL + 1                                               07350307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          07360307
 0271 CONTINUE                                                          07370307
C                                                                       07380307
C     ****  FCVS PROGRAM 307  -  TEST 027  ****                         07390307
C                                                                       07400307
C     VARIABLE ARGUMENT                                                 07410307
C                                                                       07420307
      IVTNUM =  27                                                      07430307
      IF (ICZERO) 30270, 0270, 30270                                    07440307
 0270 CONTINUE                                                          07450307
      RVCOMP =10.0                                                      07460307
      RVON01 = 2.0                                                      07470307
      RVCOMP = SINH (RVON01)                                            07480307
      RVCORR = 3.6269                                                   07490307
40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271                          07500307
40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270                          07510307
30270 IVDELE = IVDELE + 1                                               07520307
      WRITE (I02,80000) IVTNUM                                          07530307
      IF (ICZERO) 10270, 0281, 20270                                    07540307
10270 IVPASS = IVPASS + 1                                               07550307
      WRITE (I02,80002) IVTNUM                                          07560307
      GO TO 0281                                                        07570307
20270 IVFAIL = IVFAIL + 1                                               07580307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          07590307
 0281 CONTINUE                                                          07600307
C                                                                       07610307
C     ****  FCVS PROGRAM 307  -  TEST 028  ****                         07620307
C                                                                       07630307
C     ARRAY ELEMENT NAME ARGUMENT                                       07640307
C                                                                       07650307
      IVTNUM =  28                                                      07660307
      IF (ICZERO) 30280, 0280, 30280                                    07670307
 0280 CONTINUE                                                          07680307
      RVCOMP = 10.0                                                     07690307
      RAON11(1) = 6.0                                                   07700307
      RVCOMP = SINH (RAON11(1))                                         07710307
      RVCORR = 201.71                                                   07720307
40280 IF (RVCOMP - 201.66) 20280, 10280, 40281                          07730307
40281 IF (RVCOMP - 201.76) 10280, 10280, 20280                          07740307
30280 IVDELE = IVDELE + 1                                               07750307
      WRITE (I02,80000) IVTNUM                                          07760307
      IF (ICZERO) 10280, 0291, 20280                                    07770307
10280 IVPASS = IVPASS + 1                                               07780307
      WRITE (I02,80002) IVTNUM                                          07790307
      GO TO 0291                                                        07800307
20280 IVFAIL = IVFAIL + 1                                               07810307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          07820307
 0291 CONTINUE                                                          07830307
C                                                                       07840307
C     TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR    07850307
C     FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND       07860307
C     ARGUMENT TYPES ARE BOTH REAL.  ONLY POSITIVE ARGUMENTS ARE TESTED.07870307
C                                                                       07880307
C                                                                       07890307
C     ****  FCVS PROGRAM 307  -  TEST 029  ****                         07900307
C                                                                       07910307
C     CONSTANT ARGUMENT                                                 07920307
C                                                                       07930307
      IVTNUM =  29                                                      07940307
      IF (ICZERO) 30290, 0290, 30290                                    07950307
 0290 CONTINUE                                                          07960307
      RVCOMP = 10.0                                                     07970307
      RVCOMP = COSH (0.0)                                               07980307
      RVCORR = 1.0                                                      07990307
40290 IF (RVCOMP - .9995) 20290, 10290, 40291                           08000307
40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290                          08010307
30290 IVDELE = IVDELE + 1                                               08020307
      WRITE (I02,80000) IVTNUM                                          08030307
      IF (ICZERO) 10290, 0301, 20290                                    08040307
10290 IVPASS = IVPASS + 1                                               08050307
      WRITE (I02,80002) IVTNUM                                          08060307
      GO TO 0301                                                        08070307
20290 IVFAIL = IVFAIL + 1                                               08080307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          08090307
 0301 CONTINUE                                                          08100307
C                                                                       08110307
C     ****  FCVS PROGRAM 307  -  TEST 030  ****                         08120307
C                                                                       08130307
C     VARIABLE ARGUMENT                                                 08140307
C                                                                       08150307
      IVTNUM =  30                                                      08160307
      IF (ICZERO) 30300, 0300, 30300                                    08170307
 0300 CONTINUE                                                          08180307
      RVCOMP = 10.0                                                     08190307
      RVON01 = 2.0                                                      08200307
      RVCOMP = COSH (RVON01)                                            08210307
      RVCORR = 3.7622                                                   08220307
40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301                          08230307
40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300                          08240307
30300 IVDELE = IVDELE + 1                                               08250307
      WRITE (I02,80000) IVTNUM                                          08260307
      IF (ICZERO) 10300, 0311, 20300                                    08270307
10300 IVPASS = IVPASS + 1                                               08280307
      WRITE (I02,80002) IVTNUM                                          08290307
      GO TO 0311                                                        08300307
20300 IVFAIL = IVFAIL + 1                                               08310307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          08320307
 0311 CONTINUE                                                          08330307
C                                                                       08340307
C     ****  FCVS PROGRAM 307  -  TEST 031  ****                         08350307
C                                                                       08360307
C     ARRAY ELEMENT NAME ARGUMENT                                       08370307
C                                                                       08380307
      IVTNUM =  31                                                      08390307
      IF (ICZERO) 30310, 0310, 30310                                    08400307
 0310 CONTINUE                                                          08410307
      RVCOMP = 10.0                                                     08420307
      RAON11(2) = 6.0                                                   08430307
      RVCOMP = COSH (RAON11(2))                                         08440307
      RVCORR = 201.72                                                   08450307
40310 IF (RVCOMP - 201.67) 20310, 10310, 40311                          08460307
40311 IF (RVCOMP - 201.77) 10310, 10310, 20310                          08470307
30310 IVDELE = IVDELE + 1                                               08480307
      WRITE (I02,80000) IVTNUM                                          08490307
      IF (ICZERO) 10310, 0321, 20310                                    08500307
10310 IVPASS = IVPASS + 1                                               08510307
      WRITE (I02,80002) IVTNUM                                          08520307
      GO TO 0321                                                        08530307
20310 IVFAIL = IVFAIL + 1                                               08540307
      WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR                          08550307
 0321 CONTINUE                                                          08560307
C                                                                       08570307
C                                                                       08580307
C     WRITE OUT TEST SUMMARY                                            08590307
C                                                                       08600307
      WRITE (I02,90004)                                                 08610307
      WRITE (I02,90014)                                                 08620307
      WRITE (I02,90004)                                                 08630307
      WRITE (I02,90000)                                                 08640307
      WRITE (I02,90004)                                                 08650307
      WRITE (I02,90020) IVFAIL                                          08660307
      WRITE (I02,90022) IVPASS                                          08670307
      WRITE (I02,90024) IVDELE                                          08680307
      STOP                                                              08690307
90001 FORMAT (" ",24X,"FM307")                                          08700307
90000 FORMAT (" ",20X,"END OF PROGRAM FM307" )                          08710307
C                                                                       08720307
C     FORMATS FOR TEST DETAIL LINES                                     08730307
C                                                                       08740307
80000 FORMAT (" ",4X,I5,6X,"DELETED")                                   08750307
80002 FORMAT (" ",4X,I5,7X,"PASS")                                      08760307
80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         08770307
80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    08780307
80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14)                        08790307
C                                                                       08800307
C     FORMAT STATEMENTS FOR PAGE HEADERS                                08810307
C                                                                       08820307
90002 FORMAT ("1")                                                      08830307
90004 FORMAT (" ")                                                      08840307
90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            08850307
90008 FORMAT (" ",21X,"VERSION 2.1" )                                   08860307
90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )         08870307
90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT")  08880307
90014 FORMAT (" ",5X,"----------------------------------------------" ) 08890307
90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             08900307
C                                                                       08910307
C     FORMAT STATEMENTS FOR RUN SUMMARY                                 08920307
C                                                                       08930307
90020 FORMAT (" ",19X,I5," TESTS FAILED" )                              08940307
90022 FORMAT (" ",19X,I5," TESTS PASSED" )                              08950307
90024 FORMAT (" ",19X,I5," TESTS DELETED" )                             08960307
      END                                                               08970307


*DECK AVINT
      SUBROUTINE AVINT (X, Y, N, XLO, XUP, ANS, IERR)
C***BEGIN PROLOGUE  AVINT
C***PURPOSE  Integrate a function tabulated at arbitrarily spaced
C            abscissas using overlapping parabolas.
C***LIBRARY   SLATEC
C***CATEGORY  H2A1B2
C***TYPE      SINGLE PRECISION (AVINT-S, DAVINT-D)
C***KEYWORDS  INTEGRATION, QUADRATURE, TABULATED DATA
C***AUTHOR  Jones, R. E., (SNLA)
C***DESCRIPTION
C
C     Abstract
C         AVINT integrates a function tabulated at arbitrarily spaced
C         abscissas.  The limits of integration need not coincide
C         with the tabulated abscissas.
C
C         A method of overlapping parabolas fitted to the data is used
C         provided that there are at least 3 abscissas between the
C         limits of integration.  AVINT also handles two special cases.
C         If the limits of integration are equal, AVINT returns a result
C         of zero regardless of the number of tabulated values.
C         If there are only two function values, AVINT uses the
C         trapezoid rule.
C
C     Description of Parameters
C         The user must dimension all arrays appearing in the call list
C              X(N), Y(N).
C
C         Input--
C         X    - real array of abscissas, which must be in increasing
C                order.
C         Y    - real array of functional values. i.e., Y(I)=FUNC(X(I)).
C         N    - the integer number of function values supplied.
C                N .GE. 2 unless XLO = XUP.
C         XLO  - real lower limit of integration.
C         XUP  - real upper limit of integration.
C                Must have XLO .LE. XUP.
C
C         Output--
C         ANS  - computed approximate value of integral
C         IERR - a status code
C              --normal code
C                =1 means the requested integration was performed.
C              --abnormal codes
C                =2 means XUP was less than XLO.
C                =3 means the number of X(I) between XLO and XUP
C                   (inclusive) was less than 3 and neither of the two
C                   special cases described in the Abstract occurred.
C                   No integration was performed.
C                =4 means the restriction X(I+1) .GT. X(I) was violated.
C                =5 means the number N of function values was .LT. 2.
C                ANS is set to zero if IERR=2,3,4,or 5.
C
C     AVINT is documented completely in SC-M-69-335
C     Original program from "Numerical Integration" by Davis &
C     Rabinowitz.
C     Adaptation and modifications for Sandia Mathematical Program
C     Library by Rondall E. Jones.
C
C***REFERENCES  R. E. Jones, Approximate integrator of functions
C                 tabulated at arbitrarily spaced abscissas,
C                 Report SC-M-69-335, Sandia Laboratories, 1969.
C***ROUTINES CALLED  XERMSG
C***REVISION HISTORY  (YYMMDD)
C   690901  DATE WRITTEN
C   890831  Modified array declarations.  (WRB)
C   890831  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   900326  Removed duplicate information from DESCRIPTION section.
C           (WRB)
C   920501  Reformatted the REFERENCES section.  (WRB)
C***END PROLOGUE  AVINT
C
      DOUBLE PRECISION R3,RP5,SUM,SYL,SYL2,SYL3,SYU,SYU2,SYU3,X1,X2,X3
     1,X12,X13,X23,TERM1,TERM2,TERM3,A,B,C,CA,CB,CC
      DIMENSION X(*),Y(*)
C***FIRST EXECUTABLE STATEMENT  AVINT
      IERR=1
      ANS =0.0
      IF (XLO-XUP) 3,100,200
    3 IF (N.LT.2) GO TO 215
      DO 5 I=2,N
      IF (X(I).LE.X(I-1)) GO TO 210
      IF (X(I).GT.XUP) GO TO 6
    5 CONTINUE
    6 CONTINUE
      IF (N.GE.3) GO TO 9
C
C     SPECIAL N=2 CASE
      SLOPE = (Y(2)-Y(1))/(X(2)-X(1))
      FL = Y(1) + SLOPE*(XLO-X(1))
      FR = Y(2) + SLOPE*(XUP-X(2))
      ANS = 0.5*(FL+FR)*(XUP-XLO)
      RETURN
    9 CONTINUE
      IF (X(N-2).LT.XLO)  GO TO 205
      IF (X(3).GT.XUP)    GO TO 205
      I = 1
   10 IF (X(I).GE.XLO) GO TO 15
      I = I+1
      GO TO 10
   15 INLFT = I
      I = N
   20 IF (X(I).LE.XUP) GO TO 25
      I = I-1
      GO TO 20
   25 INRT = I
      IF ((INRT-INLFT).LT.2) GO TO 205
      ISTART = INLFT
      IF (INLFT.EQ.1) ISTART = 2
      ISTOP  = INRT
      IF (INRT.EQ.N)  ISTOP  = N-1
C
      R3 = 3.0D0
      RP5= 0.5D0
      SUM = 0.0
      SYL = XLO
      SYL2= SYL*SYL
      SYL3= SYL2*SYL
C
      DO 50 I=ISTART,ISTOP
      X1 = X(I-1)
      X2 = X(I)
      X3 = X(I+1)
      X12 = X1-X2
      X13 = X1-X3
      X23 = X2-X3
      TERM1 = DBLE(Y(I-1))/(X12*X13)
      TERM2 =-DBLE(Y(I)) /(X12*X23)
      TERM3 = DBLE(Y(I+1))/(X13*X23)
      A = TERM1+TERM2+TERM3
      B = -(X2+X3)*TERM1 - (X1+X3)*TERM2 - (X1+X2)*TERM3
      C = X2*X3*TERM1 + X1*X3*TERM2 + X1*X2*TERM3
      IF (I-ISTART) 30,30,35
   30 CA = A
      CB = B
      CC = C
      GO TO 40
   35 CA = 0.5*(A+CA)
      CB = 0.5*(B+CB)
      CC = 0.5*(C+CC)
   40 SYU = X2
      SYU2= SYU*SYU
      SYU3= SYU2*SYU
      SUM = SUM + CA*(SYU3-SYL3)/R3  + CB*RP5*(SYU2-SYL2) + CC*(SYU-SYL)
      CA  = A
      CB  = B
      CC  = C
      SYL = SYU
      SYL2= SYU2
      SYL3= SYU3
   50 CONTINUE
      SYU = XUP
      ANS = SUM + CA*(SYU**3-SYL3)/R3 + CB*RP5*(SYU**2-SYL2)
     1  + CC*(SYU-SYL)
  100 RETURN
  200 IERR=2
      CALL XERMSG ('SLATEC', 'AVINT',
     +   'THE UPPER LIMIT OF INTEGRATION WAS NOT GREATER THAN THE ' //
     +   'LOWER LIMIT.', 4, 1)
      RETURN
  205 IERR=3
      CALL XERMSG ('SLATEC', 'AVINT',
     +   'THERE WERE LESS THAN THREE FUNCTION VALUES BETWEEN THE ' //
     +   'LIMITS OF INTEGRATION.', 4, 1)
      RETURN
  210 IERR=4
      CALL XERMSG ('SLATEC', 'AVINT',
     +   'THE ABSCISSAS WERE NOT STRICTLY INCREASING.  MUST HAVE ' //
     +   'X(I-1) .LT. X(I) FOR ALL I.', 4, 1)
      RETURN
  215 IERR=5
      CALL XERMSG ('SLATEC', 'AVINT',
     +   'LESS THAN TWO FUNCTION VALUES WERE SUPPLIED.', 4, 1)
      RETURN
      END


 implicit none

 integer :: i,n

 print*,'Give highest number n to be squared'; read*,n

 i=0
 do
   i=i+1
   print*,i**2
   IF (i.EQ.n) exit
 end do

 end


    program demo_digits
    implicit none
    integer :: i = 12345
    real :: x = 3.143
    doubleprecision :: y = 2.33d0
       print *,'default integer:', digits(i)
       print *,'default real:   ', digits(x)
       print *,'default doubleprecision:', digits(y)
    end program demo_digits


program precision_test
    use, intrinsic :: iso_fortran_env, only : REAL32, REAL64
    implicit none
    real :: var
    integer, parameter :: sp = kind(1.0), &
                          dp = selected_real_kind(2*precision(1.0_sp))

    var = 1.0
    print *, "sp = ", sp
    print *, "dp = ", dp
    print *, "REAL = ", kind(var)

    print *, "REAL32 = ", REAL32
    print *, "REAL64 = ", REAL64

end program precision_test


module Utilities

  use Constants

  implicit none

contains

  function kron(x)
    ! Kronecker delta
    real,      intent(in)             :: x
    real                              :: kron

    if (x .gt. 0.0) then
       kron=1.0
    else
       kron=0.0
    endif

  end function kron

  function roundtoN(x,N)
    ! Round to N decimal places
    real,    intent(in)             :: x
    integer, intent(in)             :: N
    real                            :: roundtoN

    real                            :: factor

    factor=10**N
    roundtoN=float(int(x * factor  + 0.5)) / factor

  end function roundtoN

  subroutine stddev(array,arith_mean,std_deviation,missing)
    ! Compute the mean and standard deviation of an array
    real, dimension(:), intent(in)   :: array
    real,               intent(out)  :: arith_mean
    real,               intent(out)  :: std_deviation
    real, optional,     intent(in)   :: missing

    real                             :: sqr_sum
    integer                          :: nelems

       if (present(missing)) then
          nelems=count(array .ne. missing)
          arith_mean=sum(array,mask=array .ne. missing)/float(nelems)
          sqr_sum=sum(array**2,mask=array .ne. missing)
       else
          nelems=size(array)
          arith_mean=sum(array)/float(nelems)
          sqr_sum=sum(array**2)
       endif

       if ( nelems == 0 ) then
          std_deviation=0.0
          return
       endif

       !Sample standard deviation
       std_deviation=sqrt((sqr_sum-nelems*arith_mean**2)/(nelems-1))

  end subroutine stddev

  subroutine sort(array,length)
    ! Sort (because we'd like to have the genera etc. names in alphabetical
    ! order)
    character(len=*), dimension(length), intent(inout) :: array
    integer,                             intent(in)    :: length

    character(len=MAX_NLEN)                    :: temp
    integer                                    :: inc,lower,upper
    integer                                    :: i,j

    ! Sorts an array with indices running from 1 to length in place using
    ! Shell sort
    ! Shell sort is fine for small arrays (these will never be large).
    ! This is for character strings up to length NLEN.
    ! It will use lexigraphical ordering.

    lower=lbound(array,1)
    upper=ubound(array,1)

    inc=length/2

    ! We continue until the stride is the lower bound

    do while (inc > 0)
       do i=inc+lower,upper
          temp=adjustl(array(i))
          j=i
          ! Cannot use j>inc .and. array(j-inc)>temp if it doesn't short-circuit
          do while ( j > inc )
             if ( array(j-inc) > temp ) then
                array(j)=array(j-inc)
                j=j-inc
             else
                exit
             endif
          enddo
          array(j)=temp
       enddo
       if ( inc == 2 ) then
          inc=1
       else
          inc=int(real(inc)/2.2)
       endif
    enddo

  end subroutine sort

end module Utilities


program test_model_ar

    use forlab, only: disp, file
    use fortsa_model, only: ar_init, ar_exec, &
                            ar_summary, ar_predict, &
                            ar_free
    use stdlib_error, only: error_stop
    use, intrinsic :: iso_c_binding, only: c_loc, c_null_ptr, c_ptr
    implicit none
    integer :: i, d, L
    integer :: p, q, line_num
    real(8), target, allocatable :: xpred(:), amse(:)
    type(c_ptr) :: obj = c_null_ptr
    target obj
    ! type(arima_set), target :: set
    ! target set
    ! type(arima_set) :: obj
    type(file) :: infile
    real(8), target, allocatable :: inp(:)

    p = 0
    d = 1
    q = 0

    L = 5

    infile = file('example/data/seriesA.txt')
    if (.not. infile%exist()) call error_stop('Error: file not exist, '//infile%filename)
    call infile%open()
    line_num = infile%countlines()
    allocate (inp(line_num), xpred(L), amse(L))

    do i = 1, line_num
        read (infile%unit, *) inp(i)
    end do

    obj = ar_init(0, line_num)
    call ar_exec(obj, inp)
    call ar_summary(obj)
    call ar_predict(obj, inp, L, xpred, amse)

    call disp(xpred, 'Predicted Values : ')
    call disp(sqrt(amse), 'Standard Errors : ')

    call ar_free(obj)
    deallocate (inp, xpred, amse)
    call infile%close()

end program test_model_ar


      subroutine dblex
c
c     + + + PURPOSE + + +
c     Generates step functions to represent delta-t and delta--
c     intensity, for cases where intensity is NOT constant, by
c     solving a double exponential distribution function.
c     (Updates INTDL(20) & TIMEDL(20). )
c
c     Note: Either DBLEX is called from DISAG, or CONST is, but
c           NOT BOTH!
c
c     This is a double exponential distribution
c      1. for 0 <= timedl(i) <= tp
c         i(timedl(i)) = a*exp(b*timedl(i))
c         timedl(i+1) = (1.0/b)*log(1.0 + b*fq/a)
c      2. for tp <= timedl(i) <= 1.0
c         i(timedl(i)) = ip*exp(-c*(timedl(i)-tp))
c         timedl(i) = tp-(1.0/c)*log(1.0 - (c/ip)*(fq-tp))
c
c     Called from DISAG.
c     Author(s): Lane, Lopez, Stone
c     Reference in User Guide:
c
c     Changes:
c           1) Statement:     if(timep .ge. 1.)timep=0.99
c              Changed to:    if(timep .gt. 0.99) timep=0.99
c              Note: This ALSO seems to cause changes in the predicted
c                    point of maximum detachment, when the detachment
c                    rate is nearly constant.  CRM 4/9/91 (See APPMTH.)
c           2) Statement removed:  intdl(1) = a
c              (It was being re-calculated before it was used, in the
c              "do 20" loop.)
c           3) The "do 20" loop was eliminated by integrating it's
c              code into the "do 10" loop.
c           4) SAVE statement, which saves ALL local variables, removed.
c
c     Version: This module recoded from WEPP version 91.10.
c     Date recoded: 04/09/91.
c     Recoded by: Charles R. Meyer.
c
c     + + + KEYWORDS + + +
c
c     + + + PARAMETERS + + +
c     includes for sdate tracking debug
      include 'pmxpln.inc'
      include 'pmxtil.inc'
      include 'pmxtls.inc'
      include 'cupdate.inc'
c     end includes for sdate tracking
c
c     + + + COMMON BLOCKS + + +
      include 'cdiss2.inc'
c     modify: timedl(20)
c      write: intdl(20)
c
      include 'cdiss11.inc'
c       read: ninten(mxplan)
c
      include 'cdiss3.inc'
c       read: timep, ip, deltfq
c
      include 'cstruc.inc'
c       read: iplane
c
c     + + + LOCAL VARIABLES + + +
      integer err, i, i1
      real a, u, b, d, fqx
c
c     + + + LOCAL DEFINITIONS + + +
c     err    - Flag. 0: equation solved.
c                    1: no solution for given A.
c     a      - constant in the equation:  1 - exp(-U) = A*U.
c              (in this routine, A = 1/Ip.)
c     u      - see A above
c     b      - coefficient in double exponential
c     d      - coefficient in double exponential
c     fqx    - For idntermediate calcs. Starts with the value of 0.
c
c     + + + SUBROUTINES CALLED + + +
c     eqroot
c
c     + + + END SPECIFICATIONS + + +
c
c                                                                 *
c******************************************************************
c
c
c     Check to make sure Ip is in range so machine can make the
c     calculations without a machine overflow, make Ip <= 60.0
c     if Ip was greater than 60.0
c
      if (ip.gt.60.0) ip = 60.0
      if (timep.gt.0.99) timep = 0.99
c
c     Newton's method for B and then A in i(t)=a*exp(b*t)
c
c     Original Code:
c     u = eqroot(1./ip,err)
      call eqroot(1./ip,err,u)
      b = u / timep
      a = ip * exp(-u)
c
c     The formulas for dissagregation give u=btp=d(1-tp).
c
      d = u / (1.-timep)
c
c     (TIMEDL(1) and INTDL(NINT) are initialized in DISAG.)
c
      timedl(ninten(iplane)) = 1.0
      fqx = 0.0
      do 10 i = 1, ninten(iplane) - 1
        i1 = i + 1
        if (i.lt.(ninten(iplane)-1)) then
          fqx = fqx + deltfq
          if (fqx.le.timep) then
            timedl(i1) = (1.0/b) * log(1.0+(b/a)*fqx)
          else
            timedl(i1) = timep - (1.0/d) * log(1.0-(d/ip)*(fqx-timep))
          end if
        end if
c
c          intdl(i) = deltfq / (timedl(i1)-timedl(i))
c
c     inserted to avoid devide by zero when using SALFORD95 Compiler
c     11/12/98. Added again 4-24-2008 when extensive floating trap
c     compiler options are used on Intel compiler.
c
        if ((timedl(i1)-timedl(i)).gt.0)then
          intdl(i) = deltfq / (timedl(i1)-timedl(i))
        else
c         print*, sdate,timedl(i1), timedl(i)
          intdl(i) = deltfq / 0.00001
        endif
c
c     end of SALFORD95 insert
c
   10 continue
c
      return
      end


MODULE cmprs_rsb_wave

!=======================================================================
!
! This module contains a subroutine generating analytical solutions for
! the compressional Rossby waves.
!
! The default test uses the following special treatments:
! 1. Generalized equatorial f-plane, where the traditional and
!    nontraditional Coriolis parameters are 0 and 2*omega.
! 2. Fast planetary rotation rate of omega = 6.973339d-3 s^-1
! 3. Barotropic ideal gas, where the Poisson constant (rd/cp) and heat
!    capacity ratio (cp/cv) are 0 and 1.
!
! If width = 2.d6 m, and depth = 12500 m (anelastic) or 12721 m (fully
! compressible), the wave period will be 86400 s.
!
!=======================================================================

  IMPLICIT NONE

!=======================================================================
! physical constants
!=======================================================================
  REAL(8), PARAMETER ::          &
    g     = 9.80616d0,           & ! acceleration due to gravity (m s^-2)
    rd    = 287.0d0,             & ! gas constant for dry air (J K^-1 kg^-1)
    rd_cp = 0.d0,                & ! Poisson constant (rd/cp), i.e., kappa
    cp_cv = 1.d0,                & ! heat capacity ratio (cp/cv), i.e., gamma
    p0    = 1.d5,                & ! reference pressure (Pa)
    pi    = 3.141592653589793d0, & ! pi
    omega = 6.973339d-3            ! planetary rotation rate (s^-1)

!=======================================================================
!  test case parameters
!=======================================================================
  REAL(8), PARAMETER ::            &
    t0      = 311.0d0                ! basic-state temperature (K)

  CONTAINS

  SUBROUTINE cmprs_rsb_wave_test(elastic, amp, wid, dep, x, z, tim, u, v, w, pb, t, phi, pp) &
             BIND(c, name = "cmprs_rsb_wave_test")

    IMPLICIT NONE

!=======================================================================
!   input variables
!=======================================================================
    REAL(8), INTENT(IN) :: &
      elastic, & ! fully compressible (1.) or anelastic (0.)
      amp,     & ! amplitude scaling factor
      wid,     & ! domain width i.e. zonal wavelength (m)
      dep,     & ! domain depth i.e. half vertical wavelength (m)
      x,       & ! Cartesian x-coordinate (m)
      z,       & ! Cartesian z-coordinate (m)
      tim        ! time (s)

!=======================================================================
!   output variables
!=======================================================================
    REAL(8), INTENT(OUT) :: &
      u,       & ! zonal velocity (m s^-1)
      v,       & ! meridional velocity (m s^-1)
      w,       & ! vertical velocity (m s^-1)
      pb,      & ! basic-state pressure (Pa)
      t,       & ! temperature (K)
      phi,     & ! perturbation Exner function times cp*theta (J kg^-1)
      pp         ! perturbation pressure (Pa)

!=======================================================================
!   local variables
!=======================================================================
    REAL(8) :: rH, k_wave, m_wave, omega_wave, u0, phi0, w0, phsh_phi, phsh_u

!=======================================================================
!   Generate wave parameters
!=======================================================================
    rH         = g/(rd*t0)                                                         ! inverse density scale height (m^-1)
    k_wave     = 2.d0*pi/wid                                                       ! wavenumber in zonal (m^-1)
    m_wave     = pi/dep                                                            ! wavenumber in vertical (m^-1)
    omega_wave = 2.d0*omega*k_wave*rH/( k_wave**2 +m_wave**2 +0.25d0*rH**2 &       ! wave frequency (s^-1)
                                       +elastic*4.d0*omega**2/(rd*t0) )
    u0         = 0.09d0*amp                                                        ! wave amplitude in u (m s^-1)
    phi0       = u0*(4.d0*omega**2-omega_wave**2)*( omega**2*rH**2 &               ! wave amplitude in phi (J kg^-1)
                     +4.d0*omega**2*m_wave**2 -2.d0*omega*omega_wave*k_wave*rH &
                     +omega_wave**2*k_wave**2 )**(-0.5)
    w0         = phi0*k_wave*(4.d0*omega**2-omega_wave**2)**(-0.5)                 ! wave amplitude in w (m s^-1)
    phsh_phi   = atan((0.5d0*omega_wave*rH-2.d0*omega*k_wave)/(m_wave*omega_wave)) ! phase shift for phi
    phsh_u     = phsh_phi + atan(2.d0*omega*m_wave/(omega*rH-omega_wave*k_wave))   ! phase shift for u

!=======================================================================
!   Generate analytical solutions
!=======================================================================
    u   = u0  *exp(0.5d0*z*rH)*cos(m_wave*z+phsh_u  )*cos(k_wave*x-omega_wave*tim)
    v   = 0.d0
    w   = w0  *exp(0.5d0*z*rH)*sin(m_wave*z         )*sin(k_wave*x-omega_wave*tim)
    pb  = p0  *exp(     -z*rH)
    t   = t0
    phi = phi0*exp(0.5d0*z*rH)*cos(m_wave*z+phsh_phi)*cos(k_wave*x-omega_wave*tim)
    pp  = phi *pb/(rd*t0)

  ENDSUBROUTINE cmprs_rsb_wave_test

ENDMODULE cmprs_rsb_wave


module maidenhead

use, intrinsic :: iso_fortran_env, only : real64

implicit none (type, external)

contains

elemental subroutine maiden2latlon(maiden, center, lat, lon)
!! convert Maidenhead grid to latitude, longitude
!!
!! Parameters
!! ----------

!! maiden : str
!!     Maidenhead grid locator of length 2 to 8

!! center : bool
!!     If true, return the center of provided maidenhead grid square, instead of default south-west corner
!!     Default value = False needed to maidenhead full backward compatibility of this module.

!! Returns
!! -------

!! lat : float
!!     Geographic latitude
!! lon : float
!!     Geographic longitude

character(*), intent(in) :: maiden
logical, intent(in) :: center
real(real64), intent(out) :: lon, lat

character(8) :: maid
integer :: N, Oa
integer :: j, i

maid = toUpper(maiden)

N = len_trim(maiden)
if(modulo(N, 2) /= 0) error stop "Maidenhead locator requires even number of characters"
if(N < 2 .or. N > 8) error stop "Maidenhead locator requires 2-8 characters"

Oa = iachar("A")
lon = -180.0
lat = -90.0

!> first pair
lon = lon + (iachar(maid(1:1)) - Oa) * 20
lat = lat + (iachar(maid(2:2)) - Oa) * 10
!> second pair
if (N >= 4) then
  read(maid(3:3), '(I1)', iostat=i) j
  if(i/=0) error stop "expect integers as 3rd and 4th values"
  lon = lon + j * 2
  read(maid(4:4), '(I1)', iostat=i) j
  if(i/=0) error stop "expect integers as 3rd and 4th values"
  lat = lat + j * 1
endif
!> third pair
if (N >= 6) then
  lon = lon + (iachar(maid(5:5)) - Oa) * 5.0 / 60
  lat = lat + (iachar(maid(6:6)) - Oa) * 2.5 / 60
endif
!> fourth pair
if (N >= 8) then
  read(maid(7:7), '(I1)', iostat=i) j
  if(i/=0) error stop "expect integers as 7th and 8th values"
  lon = lon + j * 5.0 / 600
  read(maid(8:8), '(I1)') j
  if(i/=0) error stop "expect integers as 7th and 8th values"
  lat = lat + j * 2.5 / 600
endif

!> move lat lon to the center (if requested)
if(center) then
  select case (N)
  case(2)
    lon = lon + 20 / 2
    lat = lat + 10 / 2
  case(4)
    lon = lon + 2 / 2
    lat = lat + 1.0 / 2
  case(6)
    lon = lon + 5.0 / 60 / 2
    lat = lat + 2.5 / 60 / 2
  case(8)
    lon = lon + 5.0 / 600 / 2
    lat = lat + 2.5 / 600 / 2
  case default
    error stop "maidenhead locator requires 2, 4, 6, or 8 characters"
  end select
endif

end subroutine maiden2latlon

elemental function toUpper(str)
!! ASCII letters to uppercase
character(*), intent(in) :: str
character(len(str)) :: toUpper
character(*), parameter :: lower="abcdefghijklmnopqrstuvwxyz", &
                            upper="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
integer :: i,j

toUpper = str

!do concurrent (i = 1:len(str))  ! FIXME: Flang
do i = 1,len(str)
  j = index(lower,str(i:i))
  if (j > 0) toUpper(i:i) = upper(j:j)
end do

end function toUpper

end module maidenhead


module test_rkf45

    use testdrive, only: new_unittest, unittest_type, error_type, check
    implicit none
    private

    public :: collect_rkf45

contains

    !> All tests for rkf45
    subroutine collect_rkf45(testsuite)

        type(unittest_type), allocatable, intent(out) :: testsuite(:)

        testsuite = [ &
                    new_unittest("`test_rkf45_demo1` vaild", test_rkf45_demo1) &
                    ]

    end subroutine collect_rkf45

    !> Test rkf45 demo1,
    !> solve a Bernoulli differential equation using rkf45:
    !> y' = y - 2*x/y
    subroutine test_rkf45_demo1(error)

        use rkf45_module, only: rkf45, rk
        type(error_type), allocatable, intent(out) :: error

        integer, parameter :: neqn = 1
        real(rk) :: t = 0.0, t_out = 0.0, y(neqn)
        real(rk) :: relerr = epsilon(1.0), abserr = epsilon(1.0)
        integer :: flag = 1
        integer :: iwork(5), i, n_step = 5
        real(rk) :: work(3 + 6*neqn)
        real(rk) :: t_start = 0.0, t_end = 1.0

        y = 1.0
        do i = 1, n_step

            t = t_start + (i - 1)*(t_end - t_start)/n_step
            t_out = t_start + i*(t_end - t_start)/n_step
            call rkf45(fcn, neqn, y, t, t_out, relerr, abserr, flag, work, iwork)

            call check(error, abs(y(1)-fx(t)) <= 0.11921E-06)   !! 0.119209E-06
            if (allocated(error)) return

        end do

    contains

        !> Evaluates the derivative for the ODE
        subroutine fcn(t, y, yp)
            real(rk), intent(in) :: t
            real(rk), intent(in) :: y(:)
            real(rk), intent(out) :: yp(:)

            yp(1) = y(1) - 2*t/y(1)

        end subroutine fcn

        !> Exact solution
        real(rk) function fx(t)
            real(rk), intent(in) :: t

            fx = sqrt(1 + 2*t)

        end function fx

    end subroutine test_rkf45_demo1

end module test_rkf45


! $UWHPSC/codes/fortran/circles/main.f90

program main

    use circle_mod, only: pi, area
    implicit none
    real(kind=8) :: a

    call initialize()   ! sets pi

    ! print module variable pi:
    print *, 'pi = ', pi

    ! test the area function from module:
    a = area(2.d0)
    print *, 'area for a circle of radius 2: ', a

end program main


LOGICAL FUNCTION nonear (px, x, ndime,toli)

!  checks point p against extremities of x()

  IMPLICIT NONE

  INTEGER(kind=4) :: ndime
  REAL (kind=8) :: px(ndime), x(ndime,3)
  REAL (kind=8), OPTIONAL :: toli
  ! here there is problema with the tolerance, it should consider coordinates dimensions
  REAL (kind=8), PARAMETER :: tol1=0.0001

  INTEGER(kind=4) :: i
  REAL(kind=8) :: xmax,xmin,tol

  nonear = .FALSE.
  IF( PRESENT(toli))THEN
    tol = toli
  ELSE
    tol = tol1
  END IF
  DO i=1,ndime
    xmin = MINVAL(x(i,1:3))       !minimum value for this coordinate
    xmax = MAXVAL(x(i,1:3))       !maximum value for this coordinate

    IF( px(i) < xmin-tol .OR. px(i) > xmax+tol )THEN
      nonear = .TRUE.
      EXIT
    END IF
  END DO

  RETURN

END FUNCTION nonear