SUBROUTINE GSMCONST(DTPH) !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE GSMCONST !> !> SUBPROGRAM: GSMCONST - INITIALIZE CONSTANTS AND LOOKUP TABLES FOR MICROPHYSICS !> PROGRAMMER: FERRIER !> ORG: W/NP22 !> DATE: 01-02-?? !> !> ABSTRACT: !> READS VARIOUS MICROPHYSICAL LOOKUP TABLES USED IN COLUMN_MICRO !> LOOKUP TABLES WERE CREATED "OFFLINE" AND ARE READ IN DURING EXECUTION !> CREATES LOOKUP TABLES FOR SATURATION VAPOR PRESSURE W/R/T WATER & ICE !> !> PROGRAM HISTORY LOG: !> 01-02-?? FERRIER - ORIGINATOR !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> DTPH - PHYSICS TIME STEP (S) !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: CMICRO_CONS !> CMY600 !> F77KINDS !> IACCR_TABLES !> IMASS_TABLES !> IRATE_TABLES !> IRIME_TABLES !> IVENT_TABLES !> MAPOT !> PARMETA !> RACCR_TABLES !> RMASS_TABLES !> RRATE_TABLES !> RVELR_TABLES !> RVENT_TABLES !> SDENS_TABLES !> !> DRIVER : GSMDRIVE !> !> CALLS : GPVS !> MY_GROWTH_RATES !>-------------------------------------------------------------------------------------------------- USE CMICRO_CONS USE CMY600 USE F77KINDS USE IACCR_TABLES USE IMASS_TABLES USE IRATE_TABLES USE IRIME_TABLES USE IVENT_TABLES USE MAPOT USE PARMETA USE RACCR_TABLES USE RMASS_TABLES USE RRATE_TABLES USE RVELR_TABLES USE RVENT_TABLES USE SDENS_TABLES ! IMPLICIT NONE !----------------------------------------------------- ! PARAMETERS AND DATA STATEMENT FOR LOCAL CALCULATIONS !----------------------------------------------------- REAL (KIND=R4KIND), PARAMETER :: C1 = 1. / 3. REAL (KIND=R4KIND), PARAMETER :: DMR1 = .1E-3 REAL (KIND=R4KIND), PARAMETER :: DMR2 = .2E-3 REAL (KIND=R4KIND), PARAMETER :: DMR3 = .32E-3 REAL (KIND=R4KIND), PARAMETER :: N0R0 = 8.E6 REAL (KIND=R4KIND), PARAMETER :: N0S0 = 4.E6 REAL (KIND=R4KIND), PARAMETER :: RHOL = 1000. REAL (KIND=R4KIND), PARAMETER :: RHOS = 100. REAL (KIND=R4KIND), PARAMETER :: T0C = 273.15 REAL (KIND=R4KIND), PARAMETER :: XMR1 = 1.E6 * DMR1 REAL (KIND=R4KIND), PARAMETER :: XMR2 = 1.E6 * DMR2 REAL (KIND=R4KIND), PARAMETER :: XMR3 = 1.E6 * DMR3 ! INTEGER(KIND=I4KIND), PARAMETER :: MDR1 = XMR1 INTEGER(KIND=I4KIND), PARAMETER :: MDR2 = XMR2 INTEGER(KIND=I4KIND), PARAMETER :: MDR3 = XMR3 !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & DTPH ! REAL (KIND=R4KIND) ::& & DX , PI , BBFR , FPVS0 , XNCW ! INTEGER(KIND=I4KIND) ::& & I !-------------------------------------------------------------------------------------- ! 09/01/01: ASSUME THE FOLLOWING FUNCTIONAL DEPENDENCE FOR 5 - 100 KM RESOLUTION: ! RHGRD=0.90 FOR DX=100 KM, 0.98 FOR DX=5 KM, WHERE RHGRD=0.90+0.08*[(100.-DX)/95.]**.5 !-------------------------------------------------------------------------------------- DX = 111. * (DPHD ** 2 + DLMD ** 2) ** .5 ! MODEL RESOLUTION AT EQUATOR (KM) DX = MIN(100., MAX(5., DX) ) !DIEGO Moved to GSMDRIVE RHGRD = 0.90 + .08 * ((100. - DX)/95.) ** .5 !--------------------------------------------------------------------- ! CREATE LOOKUP TABLES FOR SATURATION VAPOR PRESSURE W/R/T WATER & ICE !--------------------------------------------------------------------- CALL GPVS !------------------------------ ! READ IN VARIOUS LOOKUP TABLES !------------------------------ OPEN (UNIT=1,FILE="ETA_MICRO_LOOKUP.dat",FORM="UNFORMATTED") READ(1) VENTR1 READ(1) VENTR2 READ(1) ACCRR READ(1) MASSR READ(1) VRAIN READ(1) RRATE READ(1) VENTI1 READ(1) VENTI2 READ(1) ACCRI READ(1) MASSI READ(1) VSNOWI ! VSNOWI = VSNOWI * VSNOWADST ! READ(1) VEL_RF ! CLOSE (1) !-------------------------------------------------------------------------------------------------- ! CALCULATES COEFFICIENTS FOR GROWTH RATES OF ICE NUCLEATED IN WATER SATURATED CONDITIONS, SCALED ! BY PHYSICS TIME STEP (LOOKUP TABLE) !-------------------------------------------------------------------------------------------------- CALL MY_GROWTH_RATES(DTPH) ! PI = ACOS(-1.) !-------------------------------------------------------------------------------------------------- ! CONSTANTS ASSOCIATED WITH BIGGS (1953) FREEZING OF RAIN, AS PARAMETERIZED FOLLOWING LIN ET AL. ! (JCAM, 1983) AND REISNER ET AL. (1998, QJRMS). !-------------------------------------------------------------------------------------------------- ABFR = - 0.66 BBFR = 100. CBFR = 20. * PI * PI * BBFR * RHOL * 1.E-42 !-------------------------------------------------------------------------------------------------- ! CIACW IS USED IN CALCULATING RIMING RATES THE ASSUMED EFFECTIVE COLLECTION EFFICIENCY OF CLOUD ! WATER RIMED ONTO ICE IS =0.5 BELOW: !-------------------------------------------------------------------------------------------------- CIACW = DTPH * 0.25 * PI * 0.5 * (1.E5) ** C1 !-------------------------------------------------------------------------------------------------- ! CIACR IS USED IN CALCULATING FREEZING OF RAIN COLLIDING WITH LARGE ICE THE ASSUMED COLLECTION ! EFFICIENCY IS 1.0 !-------------------------------------------------------------------------------------------------- CIACR = PI * DTPH !-------------------------------------------------------------------------------------------------- ! BASED ON RAIN LOOKUP TABLES FOR MEAN DIAMETERS FROM 0.05 TO 0.45 MM ! FOUR DIFFERENT FUNCTIONAL RELATIONSHIPS OF MEAN DROP DIAMETER AS A FUNCTION OF RAIN RATE (RR), ! DERIVED BASED ON SIMPLE FITS TO MASS-WEIGHTED FALL SPEEDS OF RAIN AS FUNCTIONS OF MEAN DIAMETER ! FROM THE LOOKUP TABLES. !-------------------------------------------------------------------------------------------------- RR_DRMIN = N0R0 * RRATE(MDRMIN) ! RR FOR MEAN DROP DIAMETER OF .05 MM RR_DR1 = N0R0 * RRATE(MDR1) ! RR FOR MEAN DROP DIAMETER OF .10 MM RR_DR2 = N0R0 * RRATE(MDR2) ! RR FOR MEAN DROP DIAMETER OF .20 MM RR_DR3 = N0R0 * RRATE(MDR3) ! RR FOR MEAN DROP DIAMETER OF .32 MM RR_DRMAX = N0R0 * RRATE(MDRMAX) ! RR FOR MEAN DROP DIAMETER OF .45 MM ! RQR_DRMIN = N0R0 * MASSR(MDRMIN) ! RAIN CONTENT FOR MEAN DROP DIAMETER OF .05 MM RQR_DR1 = N0R0 * MASSR(MDR1) ! RAIN CONTENT FOR MEAN DROP DIAMETER OF .10 MM RQR_DR2 = N0R0 * MASSR(MDR2) ! RAIN CONTENT FOR MEAN DROP DIAMETER OF .20 MM RQR_DR3 = N0R0 * MASSR(MDR3) ! RAIN CONTENT FOR MEAN DROP DIAMETER OF .32 MM RQR_DRMAX = N0R0 * MASSR(MDRMAX) ! RAIN CONTENT FOR MEAN DROP DIAMETER OF .45 MM ! C_N0R0 = PI * RHOL * N0R0 CN0R0 = 1.E6 / C_N0R0 ** .25 ! CN0R_DMRMIN = 1. / (PI * RHOL * DMRMIN ** 4) CN0R_DMRMAX = 1. / (PI * RHOL * DMRMAX ** 4) !--------------------------------------------------------------- ! CRACW IS USED IN CALCULATING COLLECTION OF CLOUD WATER BY RAIN ! (AN ASSUMED COLLECTION EFFICIENCY OF 1.0) !--------------------------------------------------------------- CRACW = DTPH * 0.25 * PI * 1.0 ! ESW0 = 1000. * FPVS0(T0C) ! SATURATION VAPOR PRESSURE AT 0C RFMAX = 1.1 ** NRIME ! MAXIMUM RIME FACTOR ALLOWED !--------------------------------------- ! CONSTANTS PASSED THROUGH ARGUMENT LIST !--------------------------------------- ! !-------------------------------------------------------------------------------------------------- ! IMPORTANT PARAMETERS FOR SELF COLLECTION (AUTOCONVERSION) OF CLOUD WATER TO RAIN. ! ! CRAUT IS PROPORTIONAL TO THE RATE THAT CLOUD WATER IS CONVERTED BY SELF COLLECTION TO RAIN ! (AUTOCONVERSION RATE) !-------------------------------------------------------------------------------------------------- CRAUT = 1. -EXP(-1.E-3 * DTPH) !-------------------------------------------------------------------------------------------------- ! QAUT0 IS THE THRESHOLD CLOUD CONTENT FOR AUTOCONVERSION TO RAIN NEEDED FOR DROPLETS TO REACH A ! DIAMETER OF 20 MICRONS (FOLLOWING MANTON AND COTTON, 1977; BANTA AND HANSON, 1987, JCAM). ! QAUT0=1.2567, 0.8378, OR 0.4189 G/M**3 FOR DROPLET NUMBER CONCENTRATIONS OF 300, 200, AND ! 100 CM**-3, RESPECTIVELY !-------------------------------------------------------------------------------------------------- XNCW = 200.E6 ! 300 CM**-3 DROPLET CONCENTRATION QAUT0 = PI * RHOL * XNCW * (20.E-6) ** 3/6. !-------------------------------------------------------------------------------------------------- ! FOR CALCULATING SNOW OPTICAL DEPTHS BY CONSIDERING BULK DENSITY OF SNOW BASED ON EMAILS FROM ! Q. FU (6/27-28/01), WHERE OPTICAL DEPTH (T) = 1.5*SWP/(REFF*DENS), SWP IS SNOW WATER PATH, REFF ! IS EFFECTIVE RADIUS, AND DENS IS THE BULK DENSITY OF SNOW. ! ! SWP (KG/M**2)=(1.E-3 KG/G)*SWPRAD, SWPRAD IN G/M**2 USED IN RADIATION ! T = 1.5*1.E3*SWPRAD/(REFF*DENS) ! ! SEE DERIVATION FOR MASSI(INDEXS), NOTE EQUAL TO RHO*QSNOW/NSNOW ! ! SDENS=1.5E3/DENS, DENS=MASSI(INDEXS)/[PI*(1.E-6*INDEXS)**3] !-------------------------------------------------------------------------------------------------- DO I=MDIMIN,MDIMAX SDENS(I) = PI * 1.5E-15 * FLOAT(I*I*I) / MASSI(I) END DO ! RETURN ! END SUBROUTINE GSMCONST ! ! ! !---------------------------------------------------------------- ! SETS UP LOOKUP TABLE FOR CALCULATING INITIAL ICE CRYSTAL GROWTH !---------------------------------------------------------------- SUBROUTINE MY_GROWTH_RATES(DTPH) !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE MY_GROWTH_RATES !> !> SUBPROGRAM: MY_GROWTH_RATES - SETS UP LOOKUP TABLE FOR CALCULATING INITIAL ICE CRYSTAL GROWTH !> PROGRAMMER: ????? !> ORG: ????? !> DATE: ??-??-?? !> !> ABSTRACT: !> BELOW ARE TABULATED VALUES FOR THE PREDICTED MASS OF ICE CRYSTALS AFTER 600 S OF GROWTH IN WATER !> SATURATED CONDITIONS, BASED ON CALCULATIONS FROM MILLER AND YOUNG (JAS, 1979). THESE VALUES ARE !> CRUDELY ESTIMATED FROM TABULATED CURVES AT 600 S FROM FIG. 6.9 OF YOUNG (1993). !> VALUES AT TEMPERATURES COLDER THAN -27C WERE ASSUMED TO BE INVARIANT WITH TEMPERATURE. !> USED TO NORMALIZE MILLER & YOUNG (1979) CALCULATIONS OF ICE GROWTH OVER LARGE TIME STEPS USING !> THEIR TABULATED VALUES AT 600 S. !> ASSUMES 3D GROWTH WITH TIME**1.5 FOLLOWING EQ. (6.3) IN YOUNG (1993). !> !> PROGRAM HISTORY LOG: !> ??-??-?? FERRIER - ORIGINATOR !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> DTPH - PHYSICS TIME STEP (S) !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: CMY600 !> F77KINDS !> !> DRIVER : GSMCONST !> !> CALLS : ----- !>-------------------------------------------------------------------------------------------------- USE CMY600 USE F77KINDS ! IMPLICIT NONE ! REAL (KIND=R4KIND), DIMENSION(MY_T1:MY_T2) ::& & MY_600 !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & DTPH ! REAL (KIND=R4KIND) ::& & DT_ICE ! DATA MY_600 / & !------------------ ! - 1 TO -5 DEG C !------------------ & 5.5E-8 , 1.4E-7 , 2.8E-7, 6.E-7 , 3.3E-6 , & !------------------ ! - 6 TO -10 DEG C !------------------ & 2.E-6 , 9.E-7 , 8.8E-7, 8.2E-7 , 9.4E-7 , & !------------------ ! -11 TO -15 DEG C !------------------ & 1.2E-6 , 1.85E-6, 5.5E-6, 1.5E-5 , 1.7E-5 , & !------------------ ! -16 TO -20 DEG C !------------------ & 1.5E-5 , 1.E-5 , 3.4E-6, 1.85E-6, 1.35E-6, & !------------------ ! -21 TO -25 DEG C !------------------ & 1.05E-6, 1.E-6 , 9.5E-7, 9.0E-7 , 9.5E-7 , & !------------------ ! -26 TO -30 DEG C !------------------ & 9.5E-7 , 9.E-7 , 9.E-7 , 9.E-7 , 9.E-7 , & !------------------ ! -31 TO -35 DEG C !------------------ & 9.E-7 , 9.E-7 , 9.E-7 , 9.E-7 , 9.E-7 / ! DT_ICE = (DTPH / 600.) ** 1.5 MY_GROWTH = DT_ICE * MY_600 ! RETURN ! END SUBROUTINE MY_GROWTH_RATES ! ! ! !-------------------------------------------------------------------- ! LOOKUP TABLES FOR THE SATURATION VAPOR PRESSURE W/R/T WATER AND ICE !-------------------------------------------------------------------- SUBROUTINE GPVS !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE GPVS !> !> SUBPROGRAM: GPVS - COMPUTE SATURATION VAPOR PRESSURE TABLE !> PROGRAMMER: N. PHILLIPS !> ORG: W/NP2 !> DATE: 82-12-30 !> !> ABSTRACT: !> COMPUTE SATURATION VAPOR PRESSURE TABLE AS A FUNCTION OF TEMPERATURE FOR THE TABLE LOOKUP !> FUNCTION FPVS. !> EXACT SATURATION VAPOR PRESSURES ARE CALCULATED IN SUBPROGRAM FPVSX. !> THE CURRENT IMPLEMENTATION COMPUTES A TABLE WITH A LENGTH OF 7501 FOR TEMPERATURES RANGING FROM !> 180.0 TO 330.0 KELVIN. !> !> PROGRAM HISTORY LOG: !> 91-05-07 IREDELL !> 04-12-30 IREDELL - EXPAND TABLE !> 06-02-19 HONG - ICE EFFECT !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> NONE !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: COMPVS0 !> COMPVS !> F77KINDS !> !> DRIVER : GSMCONST !> !> CALLS : ----- !-------------------------------------------------------------------------------------------------- USE COMPVS0 USE COMPVS USE F77KINDS ! IMPLICIT NONE !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) ::& & XMIN , XMAX , XINC , X , T , FPVSX , FPVSX0 ! INTEGER(KIND=I4KIND) ::& & JX ! XMIN = 180.0 XMAX = 330.0 ! XINC = (XMAX - XMIN) / (NX - 1) ! C1XPVS = 1. - XMIN / XINC C2XPVS = 1. / XINC C1XPVS0 = 1. - XMIN / XINC C2XPVS0 = 1. / XINC ! DO JX=1,NX X = XMIN + (JX - 1) * XINC T = X ! TBPVS(JX) = FPVSX(T) TBPVS0(JX) = FPVSX0(T) END DO ! RETURN ! END SUBROUTINE GPVS ! ! ! FUNCTION FPVS(T) !>-------------------------------------------------------------------------------------------------- !> FUNCTION FPVS !> !> SUBPROGRAM: FPVS - COMPUTE SATURATION VAPOR PRESSURE !> PROGRAMMER: N. PHILLIPS !> ORG: W/NP2 !> DATE: 82-12-30 !> !> ABSTRACT: !> COMPUTE SATURATION VAPOR PRESSURE FROM THE TEMPERATURE. !> A LINEAR INTERPOLATION IS DONE BETWEEN VALUES IN A LOOKUP TABLE COMPUTED IN GPVS. !> SEE DOCUMENTATION FOR FPVSX FOR DETAILS. !> INPUT VALUES OUTSIDE TABLE RANGE ARE RESET TO TABLE EXTREMA. !> THE INTERPOLATION ACCURACY IS ALMOST 6 DECIMAL PLACES. !> ON THE CRAY, FPVS IS ABOUT 4 TIMES FASTER THAN EXACT CALCULATION. !> THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE. !> !> PROGRAM HISTORY LOG: !> 91-05-07 IREDELL - MADE INTO INLINABLE FUNCTION !> 94-12-30 IREDELL - EXPAND TABLE !> 96-02-19 HONG - ICE EFFECT !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> T - REAL TEMPERATURE IN KELVIN !> !> OUTPUT ARGUMENT LIST: !> FPVS - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: COMPVS !> F77KINDS !> !> DRIVER : GSMCONST !> !> CALLS : ----- !>-------------------------------------------------------------------------------------------------- USE COMPVS USE F77KINDS ! IMPLICIT NONE !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & T ! REAL (KIND=R4KIND) ::& & FPVS , XJ ! INTEGER(KIND=I4KIND) ::& & JX ! XJ = MIN(MAX(C1XPVS + C2XPVS * T, 1.), FLOAT(NX)) JX = MIN(XJ, NX - 1.) ! FPVS = TBPVS(JX) + (XJ - JX) * (TBPVS(JX + 1) - TBPVS(JX)) ! RETURN ! END FUNCTION FPVS ! ! ! FUNCTION FPVS0(T) !-------------------------------------------------------------------------------------------------- USE COMPVS0 USE F77KINDS ! IMPLICIT NONE !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & T ! REAL (KIND=R4KIND) ::& & FPVS0, XJ1 ! INTEGER(KIND=I4KIND) ::& & JX1 ! XJ1 = MIN(MAX(C1XPVS0 + C2XPVS0 * T, 1.), FLOAT(NX)) JX1 = MIN(XJ1, NX - 1.) ! FPVS0 = TBPVS0(JX1) + (XJ1 - JX1) * (TBPVS0(JX1 + 1) - TBPVS0(JX1)) ! RETURN ! END FUNCTION FPVS0 ! ! ! FUNCTION FPVSX(T) !>-------------------------------------------------------------------------------------------------- !> FUNCTION FPVSX !> !> SUBPROGRAM: FPVSX - COMPUTE SATURATION VAPOR PRESSURE !> PROGRAMMER: N. PHILLIPS !> ORG: W/NP2 !> DATE: 82-12-30 !> !> ABSTRACT: EXACTLY COMPUTE SATURATION VAPOR PRESSURE FROM TEMPERATURE. !> THE WATER MODEL ASSUMES A PERFECT GAS, CONSTANT SPECIFIC HEATS FOR GAS AND LIQUID, AND NEGLECTS !> THE VOLUME OF THE LIQUID. !> THE MODEL DOES ACCOUNT FOR THE VARIATION OF THE LATENT HEAT OF CONDENSATION WITH TEMPERATURE. !> THE ICE OPTION IS NOT INCLUDED. !> THE CLAUSIUS-CLAPEYRON EQUATION IS INTEGRATED FROM THE TRIPLE POINT TO GET THE FORMULA !> PVS = PSATK * (TR ** XA) * EXP(XB * (1. - TR)) !> WHERE TR IS TTP/T AND OTHER VALUES ARE PHYSICAL CONSTANTS THIS FUNCTION SHOULD BE EXPANDED INLINE !> IN THE CALLING ROUTINE. !> REFERENCE: EMANUEL (1994), 116 - 117. !> !> PROGRAM HISTORY LOG: !> 91-05-07 IREDELL - MADE INTO INLINABLE FUNCTION !> 94-12-30 IREDELL - EXACT COMPUTATION !> 96-02-19 HONG - ICE EFFECT !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> T - REAL TEMPERATURE IN KELVIN !> !> OUTPUT ARGUMENT LIST: !> FPVSX - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: F77KINDS !> !> DRIVER : GSMCONST !> !> CALLS : ----- !>-------------------------------------------------------------------------------------------------- USE F77KINDS ! IMPLICIT NONE ! REAL (KIND=R4KIND), PARAMETER :: CP = 1.0046E+3 REAL (KIND=R4KIND), PARAMETER :: RD = 287.04 REAL (KIND=R4KIND), PARAMETER :: RV = 4.6150E+2 REAL (KIND=R4KIND), PARAMETER :: TTP = 2.7316E+2 REAL (KIND=R4KIND), PARAMETER :: HVAP = 2.5000E+6 REAL (KIND=R4KIND), PARAMETER :: PSAT = 6.1078E+2 REAL (KIND=R4KIND), PARAMETER :: CLIQ = 4.1855E+3 REAL (KIND=R4KIND), PARAMETER :: CVAP = 1.8460E+3 REAL (KIND=R4KIND), PARAMETER :: CICE = 2.1060E+3 REAL (KIND=R4KIND), PARAMETER :: HSUB = 2.8340E+6 ! REAL (KIND=R4KIND), PARAMETER :: PSATK = PSAT * 1.E-3 REAL (KIND=R4KIND), PARAMETER :: DLDT = CVAP - CLIQ REAL (KIND=R4KIND), PARAMETER :: XA = - DLDT / RV REAL (KIND=R4KIND), PARAMETER :: XB = XA + HVAP / (RV*TTP) REAL (KIND=R4KIND), PARAMETER :: DLDTI = CVAP - CICE REAL (KIND=R4KIND), PARAMETER :: XAI = - DLDTI / RV REAL (KIND=R4KIND), PARAMETER :: XBI = XAI + HSUB / (RV*TTP) !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & T ! REAL (KIND=R4KIND) ::& & FPVSX , TR ! TR = TTP / T ! IF (T >= TTP) THEN FPVSX = PSATK * (TR ** XA) * EXP(XB * (1. - TR)) ELSE FPVSX = PSATK * (TR ** XAI) * EXP(XBI * (1. - TR)) END IF ! RETURN ! END FUNCTION FPVSX ! ! ! FUNCTION FPVSX0(T) !-------------------------------------------------------------------------------------------------- USE F77KINDS ! IMPLICIT NONE ! REAL (KIND=R4KIND), PARAMETER :: CP = 1.0046E+3 REAL (KIND=R4KIND), PARAMETER :: RD = 287.04 REAL (KIND=R4KIND), PARAMETER :: RV = 4.6150E+2 REAL (KIND=R4KIND), PARAMETER :: TTP = 2.7316E+2 REAL (KIND=R4KIND), PARAMETER :: HVAP = 2.5000E+6 REAL (KIND=R4KIND), PARAMETER :: PSAT = 6.1078E+2 REAL (KIND=R4KIND), PARAMETER :: CLIQ = 4.1855E+3 REAL (KIND=R4KIND), PARAMETER :: CVAP = 1.8460E+3 REAL (KIND=R4KIND), PARAMETER :: CICE = 2.1060E+3 REAL (KIND=R4KIND), PARAMETER :: HSUB = 2.8340E+6 ! REAL (KIND=R4KIND), PARAMETER :: PSATK = PSAT * 1.E-3 REAL (KIND=R4KIND), PARAMETER :: DLDT = CVAP - CLIQ REAL (KIND=R4KIND), PARAMETER :: XA = -DLDT / RV REAL (KIND=R4KIND), PARAMETER :: XB = XA + HVAP / (RV * TTP) REAL (KIND=R4KIND), PARAMETER :: DLDTI = CVAP - CICE REAL (KIND=R4KIND), PARAMETER :: XAI = -DLDT / RV REAL (KIND=R4KIND), PARAMETER :: XBI = XA + HSUB / (RV * TTP) !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ REAL (KIND=R4KIND) , INTENT(IN) ::& & T ! REAL (KIND=R4KIND) ::& & FPVSX0 , TR ! TR = TTP / T FPVSX0 = PSATK * (TR ** XA) * EXP(XB * (1. - TR)) ! RETURN ! END FUNCTION FPVSX0