pkg/fizhi/getcon.F

21c28da73f Ed H*0001 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0002 CBOP 0
                0003 C     !ROUTINE: GETCON
                0004
                0005 C     !INTERFACE:
                0006       FUNCTION GETCON(NAME)
                0007
                0008 C     !DESCRIPTION:
                0009 C     Generic function getcon is a repository of global variables,
                0010 C     i.e. a memory for scalar values needed throughout a large
                0011 C     program.  This function remembers floating point values.  The
                0012 C     function is called with a character name to interrogate a value.
                0013
                0014 C     !USES:
                0015       implicit none
ebd41b68eb Andr*0016 #include "CPP_EEOPTIONS.h"
21c28da73f Ed H*0017
                0018 C     !INPUT PARAMETERS:
                0019       CHARACTER*(*) NAME
                0020 CEOP
                0021
                0022       integer I
f32a6e7bc6 Andr*0023       INTEGER MAXCON
971dc45eec Andr*0024       PARAMETER (MAXCON=46)
b1fec7bce1 Ed H*0025       CHARACTER*16 ANAME(MAXCON)
21c28da73f Ed H*0026       _RL  ACON (MAXCON)
                0027       _RL  GETCON
971dc45eec Andr*0028       _RL  VECMAX, UNDEF, OB, ECC, AE, EQNX, SOLS, S0, GRAV,
21c28da73f Ed H*0029      &     SRFPRS, PIMEAN, PSTD, TSTD, SDAY, SSALB, CO2,
                0030      &     CFC11, CFC12, CFC22, ATMPOPA, PI, CPD, CPV, ALHL, ALHS,
                0031      &     STFBOL, AIRMW, H2OMW, RUNIV, RGAS, RVAP, RKAP, HEATW,
971dc45eec Andr*0032      &     HEATI, TICE, VKRM, DEG2RAD, CALTOJ, EPS, VIRTCON, EPSFAC,
                0033      &     YRLEN, DAYSCY, PERHDEG, OBLDEG
f32a6e7bc6 Andr*0034
21c28da73f Ed H*0035 C     COMPUTATIONAL CONSTANTS
                0036 C     -----------------------
b1fec7bce1 Ed H*0037       PARAMETER ( VECMAX = 65535.5    )
786db37d4c Jean*0038       PARAMETER ( UNDEF  = 1.d15      )
f32a6e7bc6 Andr*0039
21c28da73f Ed H*0040 C     ASTRONOMICAL CONSTANTS
                0041 C     ----------------------
b1fec7bce1 Ed H*0042       PARAMETER ( OB     = 23.45      )
                0043       PARAMETER ( AE     = 6371E3     )
                0044       PARAMETER ( SOLS   = 176.5      )
                0045       PARAMETER ( S0     = 1365.0     )
971dc45eec Andr*0046       PARAMETER ( EQNX   = 80.9028    )
                0047       PARAMETER ( ECC    = 0.0167     )
                0048       PARAMETER ( PERHDEG= 102.0      )
                0049       PARAMETER ( OBLDEG = 23.45      )
f32a6e7bc6 Andr*0050
21c28da73f Ed H*0051 C     TERRESTRIAL CONSTANTS
                0052 C     ---------------------
4ba05fc34a Jean*0053       PARAMETER ( GRAV   = 9.81d0     )
b1fec7bce1 Ed H*0054       PARAMETER ( SRFPRS = 984.7      )
                0055       PARAMETER ( PIMEAN = 984.7      )
                0056       PARAMETER ( PSTD   = 1000.0     )
                0057       PARAMETER ( TSTD   = 280.0      )
                0058       PARAMETER ( SDAY   = 86400.0    )
                0059       PARAMETER ( SSALB  = 0.99       )
f32a6e7bc6 Andr*0060       PARAMETER ( CO2    = 355.0      )
                0061       PARAMETER ( CFC11  = 0.3        )
                0062       PARAMETER ( CFC12  = 0.5        )
                0063       PARAMETER ( CFC22  = 0.2        )
4ba05fc34a Jean*0064       PARAMETER ( ATMPOPA= 1.d5       )
12cb336ec9 Jean*0065       PARAMETER ( PI     = 3.14159d0  )
971dc45eec Andr*0066       PARAMETER ( YRLEN  = 365.25     )
                0067       PARAMETER ( DAYSCY = 365 *4 +1  )
f32a6e7bc6 Andr*0068
21c28da73f Ed H*0069 C     THERMODYNAMIC CONSTANTS
                0070 C     -----------------------
4ba05fc34a Jean*0071       PARAMETER ( CPD    = 1004.16d0  )
b1fec7bce1 Ed H*0072       PARAMETER ( CPV    = 1869.46    )
                0073       PARAMETER ( ALHL   = 2.499E6    )
                0074       PARAMETER ( ALHS   = 2.845E6    )
                0075       PARAMETER ( STFBOL = 5.67E-8    )
4ba05fc34a Jean*0076       PARAMETER ( AIRMW  = 28.97d0    )
                0077       PARAMETER ( H2OMW  = 18.01d0    )
                0078       PARAMETER ( RUNIV  = 8314.3d0   )
b1fec7bce1 Ed H*0079       PARAMETER ( RGAS   = RUNIV/AIRMW)
                0080       PARAMETER ( RVAP   = RUNIV/H2OMW)
                0081       PARAMETER ( RKAP   = RGAS/CPD   )
                0082       PARAMETER ( HEATW  = 597.2      )
                0083       PARAMETER ( HEATI  = 680.0      )
                0084       PARAMETER ( TICE   = 273.16     )
f32a6e7bc6 Andr*0085
21c28da73f Ed H*0086 C     TURBULENCE CONSTANTS
                0087 C     --------------------
f32a6e7bc6 Andr*0088       PARAMETER ( VKRM   = 0.4        )
                0089
21c28da73f Ed H*0090 C     CONVERSION CONSTANTS
                0091 C     --------------------
4ba05fc34a Jean*0092       PARAMETER ( DEG2RAD  = PI/180.d0)
b1fec7bce1 Ed H*0093       PARAMETER ( CALTOJ = 4184.      )
f32a6e7bc6 Andr*0094
21c28da73f Ed H*0095 C     MOISTURE CONSTANTS
                0096 C     ------------------
b1fec7bce1 Ed H*0097       PARAMETER ( EPS    = 0.622      )
                0098       PARAMETER ( VIRTCON= 0.609      )
                0099       PARAMETER ( EPSFAC = EPS*HEATW/RGAS*CALTOJ )
f32a6e7bc6 Andr*0100
                0101
b1fec7bce1 Ed H*0102        DATA ANAME(1 ),ACON(1 ) / 'CP              ', CPD    /
                0103        DATA ANAME(2 ),ACON(2 ) / 'RGAS            ', RGAS   /
                0104        DATA ANAME(3 ),ACON(3 ) / 'KAPPA           ', RKAP   /
                0105        DATA ANAME(4 ),ACON(4 ) / 'LATENT HEAT COND', ALHL   /
                0106        DATA ANAME(5 ),ACON(5 ) / 'GRAVITY         ', GRAV   /
                0107        DATA ANAME(6 ),ACON(6 ) / 'STEFAN-BOLTZMAN ', STFBOL /
                0108        DATA ANAME(7 ),ACON(7 ) / 'VON KARMAN      ', VKRM   /
                0109        DATA ANAME(8 ),ACON(8 ) / 'EARTH RADIUS    ', AE     /
                0110        DATA ANAME(9 ),ACON(9 ) / 'OBLIQUITY       ', OB     /
                0111        DATA ANAME(10),ACON(10) / 'ECCENTRICITY    ', ECC    /
971dc45eec Andr*0112        DATA ANAME(11),ACON(11) / 'PERIHELION      ', PERHDEG/
b1fec7bce1 Ed H*0113        DATA ANAME(12),ACON(12) / 'VERNAL EQUINOX  ', EQNX   /
                0114        DATA ANAME(13),ACON(13) / 'SUMMER SOLSTICE ', SOLS   /
                0115        DATA ANAME(14),ACON(14) / 'MAX VECT LENGTH ', VECMAX /
                0116        DATA ANAME(15),ACON(15) / 'MOL WT H2O      ', H2OMW  /
                0117        DATA ANAME(16),ACON(16) / 'MOL WT AIR      ', AIRMW  /
                0118        DATA ANAME(17),ACON(17) / 'CPV             ', CPV    /
                0119        DATA ANAME(18),ACON(18) / 'CPD             ', CPD    /
                0120        DATA ANAME(19),ACON(19) / 'UNIV GAS CONST  ', RUNIV  /
                0121        DATA ANAME(20),ACON(20) / 'LATENT HEAT SBLM', ALHS   /
                0122        DATA ANAME(21),ACON(21) / 'FREEZING-POINT  ', TICE   /
                0123        DATA ANAME(23),ACON(23) / 'CALTOJ          ', CALTOJ /
                0124        DATA ANAME(24),ACON(24) / 'EPS             ', EPS    /
                0125        DATA ANAME(25),ACON(25) / 'HEATW           ', HEATW  /
                0126        DATA ANAME(26),ACON(26) / 'EPSFAC          ', EPSFAC /
                0127        DATA ANAME(27),ACON(27) / 'VIRTCON         ', VIRTCON/
                0128        DATA ANAME(28),ACON(28) / 'PIMEAN          ', PIMEAN /
                0129        DATA ANAME(29),ACON(29) / 'SDAY            ', SDAY   /
                0130        DATA ANAME(30),ACON(30) / 'HEATI           ', HEATI  /
                0131        DATA ANAME(31),ACON(31) / 'S0              ', S0     /
                0132        DATA ANAME(32),ACON(32) / 'PSTD            ', PSTD   /
                0133        DATA ANAME(33),ACON(33) / 'TSTD            ', TSTD   /
                0134        DATA ANAME(34),ACON(34) / 'SSALB           ', SSALB  /
                0135        DATA ANAME(35),ACON(35) / 'UNDEF           ', UNDEF  /
                0136        DATA ANAME(36),ACON(36) / 'CO2             ', CO2    /
                0137        DATA ANAME(37),ACON(37) / 'RVAP            ', RVAP   /
                0138        DATA ANAME(38),ACON(38) / 'CFC11           ', CFC11  /
                0139        DATA ANAME(39),ACON(39) / 'CFC12           ', CFC12  /
                0140        DATA ANAME(40),ACON(40) / 'CFC22           ', CFC22  /
                0141        DATA ANAME(41),ACON(41) / 'DEG2RAD         ', DEG2RAD /
                0142        DATA ANAME(42),ACON(42) / 'ATMPOPA         ', ATMPOPA/
                0143        DATA ANAME(43),ACON(43) / 'PI              ', PI     /
971dc45eec Andr*0144        DATA ANAME(44),ACON(44) / 'YRLEN           ', YRLEN  /
                0145        DATA ANAME(45),ACON(45) / 'DAYSCY          ',DAYSCY  /
                0146        DATA ANAME(46),ACON(46) / 'OBLDEG          ',OBLDEG  /
f32a6e7bc6 Andr*0147
b1fec7bce1 Ed H*0148       DO 10 I=1,MAXCON
                0149       IF(NAME.EQ.ANAME(I)) THEN
                0150          GETCON = ACON(I)
                0151          RETURN
                0152       ENDIF
                0153 10    CONTINUE
f32a6e7bc6 Andr*0154
b1fec7bce1 Ed H*0155 900   PRINT *,' CANNOT FIND FLOATING POINT CONSTANT - ',NAME
                0156       PRINT *,' GETCON - CANNOT FIND CONSTANT REQUESTED'
f32a6e7bc6 Andr*0157       RETURN
b1fec7bce1 Ed H*0158       END