diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index bc69f0ebb..abeeed7f7 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -214,7 +214,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & c variables for tracer wet deposition, real(kind=kind_phys), dimension(im,km,ntc) :: chem_c, chem_pw, & wet_dep - real(kind=kind_phys), parameter :: escav = 0.8 ! wet scavenging efficiency + ! wet scavenging efficiency + real(kind=kind_phys), parameter :: escav = 0.8 ! ! for updraft velocity calculation real(kind=kind_phys) wu2(im,km), buo(im,km), drag(im,km), diff --git a/physics/GWD/cires_orowam2017.f b/physics/GWD/cires_orowam2017.f index 8f9599f24..9c05c5796 100644 --- a/physics/GWD/cires_orowam2017.f +++ b/physics/GWD/cires_orowam2017.f @@ -55,7 +55,8 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin real(kind=kind_phys), parameter :: kedmin = 1.e-3 real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 - real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec + ! nonlin-OGW scale 1/10sec + real(kind=kind_phys), parameter :: rtau = 0.01 real(kind=kind_phys), parameter :: Linsat2 =0.5 real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 diff --git a/physics/GWD/gwdps.f b/physics/GWD/gwdps.f index ca2efeef4..6e843b239 100644 --- a/physics/GWD/gwdps.f +++ b/physics/GWD/gwdps.f @@ -359,7 +359,8 @@ subroutine gwdps_run( & ! parameter (cdmb = 1.0) !< non-dim sub grid mtn drag Amp (*j*) parameter (hncrit=8000.) !< Max value in meters for ELVMAX (*j*) ! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt - parameter (sigfac=4.0) !< MB3a expt test for ELVMAX factor (*j*) + !< MB3a expt test for ELVMAX factor (*j*) + parameter (sigfac=4.0) parameter (hminmt=50.) !< min mtn height (*j*) parameter (minwnd=0.1) !< min wind component (*j*) @@ -367,7 +368,8 @@ subroutine gwdps_run( & !! parameter (dpmin=05.0) !< Minimum thickness of the reference layer ! parameter (dpmin=20.0) !< Minimum thickness of the reference layer !< in centibars - parameter (dpmin=5000.0) !< Minimum thickness of the reference layer + !< Minimum thickness of the reference layer + parameter (dpmin=5000.0) !< in Pa ! real(kind=kind_phys) FDIR diff --git a/physics/GWD/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f index f8b4ac6a6..835dc639b 100644 --- a/physics/GWD/rayleigh_damp.f +++ b/physics/GWD/rayleigh_damp.f @@ -101,7 +101,8 @@ subroutine rayleigh_damp_run ( & ! if (lsidea .or. ral_ts <= 0.0 .or. prslrd0 == 0.0) return ! - RTRD1 = 1.0/(ral_ts*86400) ! RECIPROCAL OF TIME SCALE PER SCALE HEIGHT + ! RECIPROCAL OF TIME SCALE PER SCALE HEIGHT + RTRD1 = 1.0/(ral_ts*86400) ! ABOVE BEGINNING SIGMA LEVEL FOR RAYLEIGH DAMPING dti = cons1 / dt hfbcpdt = half / (cp*dt) diff --git a/physics/MP/Zhao_Carr/zhaocarr_gscond.f b/physics/MP/Zhao_Carr/zhaocarr_gscond.f index 1d22c09ac..ac560b75c 100644 --- a/physics/MP/Zhao_Carr/zhaocarr_gscond.f +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.f @@ -505,7 +505,8 @@ subroutine zhaocarr_gscond_run (im,km,dt,dtf,prsl,ps,q,clw1 & psp(i) = psp1(i) psp1(i) = ps(i) enddo - else ! two time level scheme - tp1, qp1, psp1 not used + ! two time level scheme - tp1, qp1, psp1 not used + else do k = 1, km ! write(0,*)' in gscond k=',k,' im=',im,' km=',km do i = 1, im diff --git a/physics/PBL/HEDMF/hedmf.f b/physics/PBL/HEDMF/hedmf.f index b75526ba6..051a845d3 100644 --- a/physics/PBL/HEDMF/hedmf.f +++ b/physics/PBL/HEDMF/hedmf.f @@ -221,7 +221,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & cc parameter(gravi=1.0/grav) parameter(gocp=grav/cp) - parameter(cont=cp/grav,conq=hvap/grav,conw=1.0/grav) ! for del in pa + ! for del in pa + parameter(cont=cp/grav,conq=hvap/grav,conw=1.0/grav) ! parameter(cont=1000.*cp/grav,conq=1000.*hvap/grav,conw=1000./grav) ! for del in kpa parameter(rlam=30.0,vk=0.4,vk2=vk*vk) parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) diff --git a/physics/PBL/SHOC/moninshoc.f b/physics/PBL/SHOC/moninshoc.f index 994b78bf6..d2b9474e6 100644 --- a/physics/PBL/SHOC/moninshoc.f +++ b/physics/PBL/SHOC/moninshoc.f @@ -567,7 +567,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif endif ! - if (ntke > 0) then ! solve tridiagonal problem for momentum and tke + ! solve tridiagonal problem for momentum and tke + if (ntke > 0) then ! ! compute tridiagonal matrix elements for tke ! diff --git a/physics/Radiation/RRTMG/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f index 3f298b9d3..a80f60a0f 100644 --- a/physics/Radiation/RRTMG/iounitdef.f +++ b/physics/Radiation/RRTMG/iounitdef.f @@ -63,7 +63,8 @@ module module_iounitdef ! integer, parameter :: NISIGI2 = 12 integer, parameter :: NISFCI = 14 integer, parameter :: NICO2TR = 15 - integer, parameter :: NICO2CN = 112 ! CCE (Cray) forbids 100-102 20211112 JM + ! CCE (Cray) forbids 100-102 20211112 JM + integer, parameter :: NICO2CN = 112 integer, parameter :: NIMTNVR = 24 integer, parameter :: NIDTBTH = 27 integer, parameter :: NIO3PRD = 28 @@ -72,9 +73,12 @@ module module_iounitdef ! integer, parameter :: NICLTUN = 43 integer, parameter :: NIO3CLM = 48 integer, parameter :: NIMICPH = 1 - integer, parameter :: NISFCYC = 111 ! CCE (Cray) forbids 100-102 20210701 JM - integer, parameter :: NIAERCM = 112 ! CCE (Cray) forbids 100-102 20210701 JM - integer, parameter :: NIRADSF = 112 ! CCE (Cray) forbids 100-102 20210701 JM + ! CCE (Cray) forbids 100-102 20210701 JM + integer, parameter :: NISFCYC = 111 + ! CCE (Cray) forbids 100-102 20210701 JM + integer, parameter :: NIAERCM = 112 + ! CCE (Cray) forbids 100-102 20210701 JM + integer, parameter :: NIRADSF = 112 ! --- ... output units diff --git a/physics/Radiation/RRTMG/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f index 6285653d2..c8b87be27 100644 --- a/physics/Radiation/RRTMG/module_bfmicrophysics.f +++ b/physics/Radiation/RRTMG/module_bfmicrophysics.f @@ -285,17 +285,27 @@ SUBROUTINE GSMCONST (DTPG,mype,first) ! 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 + !< RR for mean drop diameter of .05 mm + RR_DRmin=N0r0*RRATE(MDRmin) + !< RR for mean drop diameter of .10 mm + RR_DR1=N0r0*RRATE(MDR1) + !< RR for mean drop diameter of .20 mm + RR_DR2=N0r0*RRATE(MDR2) + !< RR for mean drop diameter of .32 mm + RR_DR3=N0r0*RRATE(MDR3) + !< RR for mean drop diameter of .45 mm + RR_DRmax=N0r0*RRATE(MDRmax) +! + !< Rain content for mean drop diameter of .05 mm + RQR_DRmin=N0r0*MASSR(MDRmin) + !< Rain content for mean drop diameter of .10 mm + RQR_DR1=N0r0*MASSR(MDR1) + !< Rain content for mean drop diameter of .20 mm + RQR_DR2=N0r0*MASSR(MDR2) + !< Rain content for mean drop diameter of .32 mm + RQR_DR3=N0r0*MASSR(MDR3) + !< Rain content for mean drop diameter of .45 mm + RQR_DRmax=N0r0*MASSR(MDRmax) C_N0r0=PI*RHOL*N0r0 CN0r0=1.E6/C_N0r0**.25 CN0r_DMRmin=1./(PI*RHOL*DMRmin**4) @@ -418,7 +428,8 @@ SUBROUTINE MY_GROWTH_RATES (DTPH) ! DT_ICE=(DTPH/600.)**1.5 ! MY_GROWTH=DT_ICE*MY_600 ! original version - MY_GROWTH=DT_ICE*MY_600*1.E-3 !-- 20090714: Convert from g to kg + !-- 20090714: Convert from g to kg + MY_GROWTH=DT_ICE*MY_600*1.E-3 ! !----------------------------------------------------------------------- ! @@ -579,8 +590,10 @@ subroutine ice_lookup c2=1./sqrt(3.) ! pi=acos(-1.) cbulk=6./pi - cbulk_ice=900.*pi/6. ! Maximum bulk ice density allowed of 900 kg/m**3 - px=.4**cexp ! Convert fall speeds from 400 mb (Starr & Cox) to 1000 mb + ! Maximum bulk ice density allowed of 900 kg/m**3 + cbulk_ice=900.*pi/6. + ! Convert fall speeds from 400 mb (Starr & Cox) to 1000 mb + px=.4**cexp ! !--------------------- Dynamic viscosity (1000 mb, 288 K) -------------------------- ! @@ -2539,13 +2552,17 @@ REAL FUNCTION CONDENSE (PP, QW, RHgrd, TK, WV) Tdum = TK WVdum = WV WCdum = QW - ESW = min(PP, FPVSL(Tdum)) ! Saturation vapor press w/r/t water + ! Saturation vapor press w/r/t water + ESW = min(PP, FPVSL(Tdum)) ! WS = RHgrd*EPS*ESW/(PP-ESW) ! Saturation mixing ratio w/r/t water - WS = RHgrd*EPS*ESW/(PP+epsm1*ESW) ! Saturation specific hum w/r/t water - DWV = WVdum - WS ! Deficit grid-scale specific humidity + ! Saturation specific hum w/r/t water + WS = RHgrd*EPS*ESW/(PP+epsm1*ESW) + ! Deficit grid-scale specific humidity + DWV = WVdum - WS SSAT = DWV / WS ! Supersaturation ratio CONDENSE = 0. - rfac = 0.5 ! converges faster with 0.5 + ! converges faster with 0.5 + rfac = 0.5 DO WHILE ((SSAT < RHLIMIT1 .AND. WCdum > EPSQ) & & .OR. SSAT > RHLIMIT) ! @@ -2595,10 +2612,13 @@ REAL FUNCTION DEPOSIT (PP, RHgrd, Tdum, WVdum) ! !----------------------------------------------------------------------- ! - ESI=min(PP, FPVSI(Tdum)) ! Saturation vapor press w/r/t ice + ! Saturation vapor press w/r/t ice + ESI=min(PP, FPVSI(Tdum)) ! WS=RHgrd*EPS*ESI/(PP-ESI) ! Saturation mixing ratio - WS=RHgrd*EPS*ESI/(PP+epsm1*ESI) ! Saturation mixing ratio - DWV=WVdum-WS ! Deficit grid-scale water vapor mixing ratio + ! Saturation mixing ratio + WS=RHgrd*EPS*ESI/(PP+epsm1*ESI) + ! Deficit grid-scale water vapor mixing ratio + DWV=WVdum-WS SSAT=DWV/WS ! Supersaturation ratio DEPOSIT=0. DO WHILE (SSAT > RHLIMIT .OR. SSAT < RHLIMIT1) @@ -2648,7 +2668,8 @@ SUBROUTINE rsipath(im, ix, ix2, levs, prsl, prsi, t, q, clw & logical lprnt ! - RECW1 = 620.3505 / TNW**CEXP ! cloud droplet effective radius + ! cloud droplet effective radius + RECW1 = 620.3505 / TNW**CEXP do l=1,levs do i=1,im @@ -2979,7 +3000,8 @@ subroutine rsipath2 & ! !===> ... begin here ! - recw1 = 620.3505 / TNW**CEXP ! cloud droplet effective radius + ! cloud droplet effective radius + recw1 = 620.3505 / TNW**CEXP do k = 1, LEVS do i = 1, IM diff --git a/physics/Radiation/RRTMG/radlw_datatb.f b/physics/Radiation/RRTMG/radlw_datatb.f index da0f5eaa3..d26a967b3 100644 --- a/physics/Radiation/RRTMG/radlw_datatb.f +++ b/physics/Radiation/RRTMG/radlw_datatb.f @@ -938,12 +938,15 @@ module module_radlw_cldprlw ! !> absrain is the rain drop absorption coefficient \f$(m^{2}/g)\f$ . ! real (kind=kind_phys), parameter :: absrain = 3.07e-3 ! chou coeff - real (kind=kind_phys), parameter :: absrain = 0.33e-3 ! ncar coeff + ! ncar coeff + real (kind=kind_phys), parameter :: absrain = 0.33e-3 !> abssnow0 is the snow flake absorption coefficient (micron), fu coeff - real (kind=kind_phys), parameter :: abssnow0 = 1.5 ! fu coeff + ! fu coeff + real (kind=kind_phys), parameter :: abssnow0 = 1.5 !> abssnow1 is the snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coeff - real (kind=kind_phys), parameter :: abssnow1 = 2.34e-3 ! ncar coeff + ! ncar coeff + real (kind=kind_phys), parameter :: abssnow1 = 2.34e-3 ! === absliq# is the liquid water absorption coefficient (m2/g). diff --git a/physics/Radiation/RRTMG/radlw_param.f b/physics/Radiation/RRTMG/radlw_param.f index bc2aae224..2f85a981e 100644 --- a/physics/Radiation/RRTMG/radlw_param.f +++ b/physics/Radiation/RRTMG/radlw_param.f @@ -75,7 +75,8 @@ module module_radlw_parameters ! !! \section arg_table_topflw_type Argument Table !! \htmlinclude topflw_type.html !! - type topflw_type !< define type construct for radiation fluxes at toa + !< define type construct for radiation fluxes at toa + type topflw_type real (kind=kind_phys) :: upfxc !< total sky upward flux at toa real (kind=kind_phys) :: upfx0 !< clear sky upward flux at toa end type topflw_type @@ -84,14 +85,16 @@ module module_radlw_parameters ! !! \section arg_table_sfcflw_type Argument Table !! \htmlinclude sfcflw_type.html !! - type sfcflw_type !< define type construct for radiation fluxes at surface + !< define type construct for radiation fluxes at surface + type sfcflw_type real (kind=kind_phys) :: upfxc !< total sky upward flux at sfc real (kind=kind_phys) :: upfx0 !< clear sky upward flux at sfc real (kind=kind_phys) :: dnfxc !< total sky downward flux at sfc real (kind=kind_phys) :: dnfx0 !< clear sky downward flux at sfc end type sfcflw_type ! - type proflw_type !< define type construct for optional radiation flux profiles + !< define type construct for optional radiation flux profiles + type proflw_type real (kind=kind_phys) :: upfxc !< level up flux for total sky real (kind=kind_phys) :: dnfxc !< level down flux for total sky real (kind=kind_phys) :: upfx0 !< level up for clear sky @@ -99,13 +102,19 @@ module module_radlw_parameters ! end type proflw_type ! ! Parameter constants for LW band structures - integer, parameter :: NBANDS = 16 !< number of total spectral bands - integer, parameter :: NGPTLW = 140 !< number of total g-points + !< number of total spectral bands + integer, parameter :: NBANDS = 16 + !< number of total g-points + integer, parameter :: NGPTLW = 140 integer, parameter :: NTBL = 10000 !< lookup table dimension - integer, parameter :: MAXGAS = 7 !< maximum number of absorbing gases - integer, parameter :: MAXXSEC= 4 !< number of halocarbon gases - integer, parameter :: NRATES = 6 !< number of ref rates of binary species - integer, parameter :: NPLNK = 181 !< dimension for plank function table + !< maximum number of absorbing gases + integer, parameter :: MAXGAS = 7 + !< number of halocarbon gases + integer, parameter :: MAXXSEC= 4 + !< number of ref rates of binary species + integer, parameter :: NRATES = 6 + !< dimension for plank function table + integer, parameter :: NPLNK = 181 integer, parameter :: NBDLW = NBANDS @@ -125,7 +134,8 @@ module module_radlw_parameters ! !> band indices for each g-point integer, dimension(NGPTLW) :: NGB - data NGB(:) / 10*1, 12*2, 16*3, 14*4, 16*5, 8*6, 12*7, 8*8, & ! band 1- 8 + ! band 1- 8 + data NGB(:) / 10*1, 12*2, 16*3, 14*4, 16*5, 8*6, 12*7, 8*8, & & 12*9, 6*10, 8*11, 8*12, 4*13, 2*14, 2*15, 2*16 / ! band 9-16 !> Band spectrum structures (wavenumber is 1/cm) diff --git a/physics/Radiation/RRTMG/radsw_datatb.f b/physics/Radiation/RRTMG/radsw_datatb.f index e0bb651e9..ebcbf6036 100644 --- a/physics/Radiation/RRTMG/radsw_datatb.f +++ b/physics/Radiation/RRTMG/radsw_datatb.f @@ -2466,7 +2466,8 @@ module module_radsw_cldprtb ! !> asymmetry coefficients real (kind=kind_phys), dimension(nblow:nbhgh), public :: c0r - data a0r,a1r / 3.07e-3, 0.0 /, a0s,a1s / 0.0, 1.5 / ! fu's coeff + ! fu's coeff + data a0r,a1r / 3.07e-3, 0.0 /, a0s,a1s / 0.0, 1.5 / data b0r / 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, 0.183, & & 0.048, 0.012, 0.000, 0.000, 0.000, 0.000, 0.496 / diff --git a/physics/Radiation/RRTMG/radsw_param.f b/physics/Radiation/RRTMG/radsw_param.f index 2086f5df8..c5afca1ad 100644 --- a/physics/Radiation/RRTMG/radsw_param.f +++ b/physics/Radiation/RRTMG/radsw_param.f @@ -121,11 +121,16 @@ module module_radsw_parameters ! integer, parameter :: NBLOW = 16 !< band range lower index integer, parameter :: NBHGH = 29 !< band range upper index - integer, parameter :: NBANDS = NBHGH-NBLOW+1 !< total number of SW bands (14) - integer, parameter :: NGPTSW = 112 !< total number of g-point in all bands - integer, parameter :: NGMAX = 16 !< maximum number of g-point in one band - integer, parameter :: MAXGAS = 7 !< maximum number of absorbing gases - integer, parameter :: NTBMX = 10000 !< index upper limit of optical depth and transmittance tables + !< total number of SW bands (14) + integer, parameter :: NBANDS = NBHGH-NBLOW+1 + !< total number of g-point in all bands + integer, parameter :: NGPTSW = 112 + !< maximum number of g-point in one band + integer, parameter :: NGMAX = 16 + !< maximum number of absorbing gases + integer, parameter :: MAXGAS = 7 + !< index upper limit of optical depth and transmittance tables + integer, parameter :: NTBMX = 10000 ! SW bands counter starting index (for compatibility with previous !! SW radiation schemes) integer, parameter :: NSWSTR = 1 diff --git a/physics/Radiation/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f index d1df168a5..6c2c7844d 100644 --- a/physics/Radiation/radiation_aerosols.f +++ b/physics/Radiation/radiation_aerosols.f @@ -184,7 +184,8 @@ module module_radiation_aerosols ! =.false.:volcanic aerosol effect is not included in radiation logical, save :: lavoflg = .true. - logical, save :: lmap_new = .true. ! use new mapping method (set in aer_init) + ! use new mapping method (set in aer_init) + logical, save :: lmap_new = .true. ! --------------------------------------------------------------------- ! ! section-1 : module variables for spectral band interpolation ! @@ -548,8 +549,10 @@ subroutine aer_init & character(len=*), intent(out) :: errmsg ! --- locals: - real (kind=kind_phys), dimension(NWVTOT) :: solfwv ! one wvn sol flux - real (kind=kind_phys), dimension(NWVTIR) :: eirfwv ! one wvn ir flux + ! one wvn sol flux + real (kind=kind_phys), dimension(NWVTOT) :: solfwv + ! one wvn ir flux + real (kind=kind_phys), dimension(NWVTIR) :: eirfwv ! !===> ... begin here ! @@ -563,9 +566,12 @@ subroutine aer_init & kyrsav = 1 kmonsav = 1 - laswflg= (mod(iaerflg,10) > 0) ! control flag for sw tropospheric aerosol - lalwflg= (mod(iaerflg/10,10) > 0) ! control flag for lw tropospheric aerosol - lavoflg= (mod(iaerflg/100,10) >0) ! control flag for stratospheric volcanic aeros + ! control flag for sw tropospheric aerosol + laswflg= (mod(iaerflg,10) > 0) + ! control flag for lw tropospheric aerosol + lalwflg= (mod(iaerflg/10,10) > 0) + ! control flag for stratospheric volcanic aeros + lavoflg= (mod(iaerflg/100,10) >0) !> -# Call wrt_aerlog to write aerosol parameter configuration to output logs. @@ -578,7 +584,8 @@ subroutine aer_init & endif - if ( iaerflg == 0 ) return ! return without any aerosol calculations + ! return without any aerosol calculations + if ( iaerflg == 0 ) return ! --- ... in sw, aerosols optical properties are computed for each radiation ! spectral band; while in lw, optical properties can be calculated @@ -610,7 +617,8 @@ subroutine aer_init & ! note: for result consistency, the defalt opac-clim aeros setting still use ! old spectral band mapping. use iaermdl=5 to use new mapping method - if ( iaermdl == 0 ) then ! opac-climatology scheme + ! opac-climatology scheme + if ( iaermdl == 0 ) then lmap_new = .false. wvn_sw1(2:NBDSW-1) = wvn_sw1(2:NBDSW-1) + 1 @@ -1000,8 +1008,10 @@ subroutine clim_aerinit & ! ================================================================== ! ! --- inputs: - real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux - real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux + ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: solfwv + ! one wvn ir flux + real (kind=kind_phys), dimension(:) :: eirfwv integer, intent(in) :: me character(len=26), intent(in) :: aeros_file ! --- output: (CCPP error handling) @@ -2066,10 +2076,12 @@ subroutine volc_update(errflg, errmsg) kmonsav = imon - if ( kyrstr<=iyear .and. iyear<=kyrend ) then ! use previously input data + ! use previously input data + if ( kyrstr<=iyear .and. iyear<=kyrend ) then kyrsav = iyear return - else ! need to input new data + ! need to input new data + else kyrsav = iyear kyrstr = iyear - mod(iyear,10) kyrend = kyrstr + 9 @@ -2255,7 +2267,8 @@ subroutine setaer & character(len=*), intent(out) :: errmsg ! --- locals: - real (kind=kind_phys), parameter :: psrfh = 5.0 ! ref press (mb) for upper bound + ! ref press (mb) for upper bound + real (kind=kind_phys), parameter :: psrfh = 5.0 real (kind=kind_phys), dimension(IMAX) :: alon,alat,volcae,rdelp ! real (kind=kind_phys), dimension(IMAX) :: sumodp @@ -3557,8 +3570,10 @@ subroutine gocart_aerinit & implicit none ! --- inputs: - real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux - real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux + ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: solfwv + ! one wvn ir flux + real (kind=kind_phys), dimension(:) :: eirfwv integer, intent(in) :: me diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index 90ed7cd45..6dc4eeca4 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -107,7 +107,8 @@ module module_radiation_astronomy real (kind=kind_phys) :: pid12 real (kind=kind_phys), parameter :: f12 = 12.0 real (kind=kind_phys), parameter :: f3600 = 3600.0 - real (kind=kind_phys), parameter :: czlimt = 0.0001 ! ~ cos(89.99427) + ! ~ cos(89.99427) + real (kind=kind_phys), parameter :: czlimt = 0.0001 ! real (kind=kind_phys), parameter :: pid12 = (2.0*asin(1.0))/f12 ! Module variable (to be set in module_radiation_astronomy::sol_init): @@ -217,7 +218,8 @@ subroutine sol_init & if ( me == 0 ) then print *,' - Using new fixed solar constant =', solc0 endif - elseif ( isolar == 1 ) then ! noaa ann-mean tsi in absolute scale + ! noaa ann-mean tsi in absolute scale + elseif ( isolar == 1 ) then solar_fname(15:26) = 'noaa_a0.txt' if ( me == 0 ) then @@ -236,7 +238,8 @@ subroutine sol_init & & ' reset control flag isolflg=',isolflg endif endif - elseif ( isolar == 2 ) then ! noaa ann-mean tsi in tim scale + ! noaa ann-mean tsi in tim scale + elseif ( isolar == 2 ) then solar_fname(15:26) = 'noaa_an.txt' if ( me == 0 ) then @@ -255,7 +258,8 @@ subroutine sol_init & & ' reset control flag isolflg=',isolflg endif endif - elseif ( isolar == 3 ) then ! cmip5 ann-mean tsi in tim scale + ! cmip5 ann-mean tsi in tim scale + elseif ( isolar == 3 ) then solar_fname(15:26) = 'cmip_an.txt' if ( me == 0 ) then @@ -274,7 +278,8 @@ subroutine sol_init & & ' reset control flag isolflg=',isolflg endif endif - elseif ( isolar == 4 ) then ! cmip5 mon-mean tsi in tim scale + ! cmip5 mon-mean tsi in tim scale + elseif ( isolar == 4 ) then solar_fname(15:26) = 'cmip_mn.txt' if ( me == 0 ) then @@ -391,9 +396,12 @@ subroutine sol_update & integer, intent(out) :: errflg ! --- locals: - real (kind=kind_phys), parameter :: hrday = 1.0/24.0 ! frc day/hour - real (kind=kind_phys), parameter :: minday= 1.0/1440.0 ! frc day/minute - real (kind=kind_phys), parameter :: secday= 1.0/86400.0 ! frc day/second + ! frc day/hour + real (kind=kind_phys), parameter :: hrday = 1.0/24.0 + ! frc day/minute + real (kind=kind_phys), parameter :: minday= 1.0/1440.0 + ! frc day/second + real (kind=kind_phys), parameter :: secday= 1.0/86400.0 real (kind=kind_phys) :: smean, solc1, dtswh, smon(12) real (kind=kind_phys) :: fjd, fjd1, dlt, r1, alp @@ -616,7 +624,8 @@ subroutine sol_update & ! --- ... setting up calculation parameters used by subr coszmn - nswr = max(1, nint(deltsw/deltim)) ! number of mdl t-step per sw call + ! number of mdl t-step per sw call + nswr = max(1, nint(deltsw/deltim)) dtswh = deltsw / f3600 ! time length in hours ! if ( deltsw >= f3600 ) then ! for longer sw call interval @@ -692,13 +701,18 @@ subroutine solar & real (kind=kind_phys), intent(out) :: r1, dlt, alp ! --- locals: - real (kind=kind_phys), parameter :: cyear = 365.25 ! days of year - real (kind=kind_phys), parameter :: ccr = 1.3e-6 ! iteration limit - real (kind=kind_phys), parameter :: tpp = 1.55 ! days between epoch and + ! days of year + real (kind=kind_phys), parameter :: cyear = 365.25 + ! iteration limit + real (kind=kind_phys), parameter :: ccr = 1.3e-6 + ! days between epoch and + real (kind=kind_phys), parameter :: tpp = 1.55 ! perihelion passage of 1900 - real (kind=kind_phys), parameter :: svt6 = 78.035 ! days between perihelion passage + ! days between perihelion passage + real (kind=kind_phys), parameter :: svt6 = 78.035 ! and march equinox of 1900 - integer, parameter :: jdor = 2415020 ! jd of epoch which is january + ! jd of epoch which is january + integer, parameter :: jdor = 2415020 ! 0, 1900 at 12 hours ut real (kind=kind_phys) :: dat, t1, year, tyear, ec, angin, ador, & @@ -873,7 +887,8 @@ subroutine coszmn & !===> ... begin here - solang = pid12 * (solhr - f12) ! solar angle at present time + ! solar angle at present time + solang = pid12 * (solhr - f12) rstp = 1.0 / float(nstp) do i = 1, IM diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 1175353de..f0b41f018 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -182,11 +182,14 @@ module module_radiation_clouds ! --- set constant parameters real (kind=kind_phys) :: gfac,gord - integer, parameter, public :: NF_CLDS = 9 !< number of fields in cloud array - integer, parameter, public :: NK_CLDS = 3 !< number of cloud vertical domains + !< number of fields in cloud array + integer, parameter, public :: NF_CLDS = 9 + !< number of cloud vertical domains + integer, parameter, public :: NK_CLDS = 3 ! pressure limits of cloud domain interfaces (low,mid,high) in mb (0.1kPa) - real (kind=kind_phys), save :: ptopc(NK_CLDS+1,2) !< pressure limits of cloud domain interfaces + !< pressure limits of cloud domain interfaces + real (kind=kind_phys), save :: ptopc(NK_CLDS+1,2) !! (low, mid, high) in mb (0.1kPa) !org data ptopc / 1050., 642., 350., 0.0, 1050., 750., 500., 0.0 / @@ -196,16 +199,24 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: climit = 0.001, climit2=0.05 real (kind=kind_phys), parameter :: ovcst = 1.0 - 1.0e-8 - real (kind=kind_phys), parameter :: reliq_def = 10.0 !< default liq radius to 10 micron - real (kind=kind_phys), parameter :: reice_def = 50.0 !< default ice radius to 50 micron - real (kind=kind_phys), parameter :: rrain_def = 1000.0 !< default rain radius to 1000 micron - real (kind=kind_phys), parameter :: rsnow_def = 250.0 !< default snow radius to 250 micron - real (kind=kind_phys), parameter :: creice_def = 25.0 !< default convective ice radius to 25 micron overland - - real (kind=kind_phys), parameter :: cldssa_def = 0.99 !< default cld single scat albedo - real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor - - integer :: llyr = 2 !< upper limit of boundary layer clouds + !< default liq radius to 10 micron + real (kind=kind_phys), parameter :: reliq_def = 10.0 + !< default ice radius to 50 micron + real (kind=kind_phys), parameter :: reice_def = 50.0 + !< default rain radius to 1000 micron + real (kind=kind_phys), parameter :: rrain_def = 1000.0 + !< default snow radius to 250 micron + real (kind=kind_phys), parameter :: rsnow_def = 250.0 + !< default convective ice radius to 25 micron overland + real (kind=kind_phys), parameter :: creice_def = 25.0 + + !< default cld single scat albedo + real (kind=kind_phys), parameter :: cldssa_def = 0.99 + !< default cld asymmetry factor + real (kind=kind_phys), parameter :: cldasy_def = 0.84 + + !< upper limit of boundary layer clouds + integer :: llyr = 2 ! Default ice crystal sizes vs. temperature following Kristjansson and Mitchell real (kind=kind_phys), dimension(95), parameter :: retab =(/ & @@ -649,7 +660,8 @@ subroutine radiation_clouds_prop & & cld_resnow) endif - elseif(imp_physics == imp_physics_zhao_carr_pdf) then ! zhao/moorthi's prognostic cloud+pdfcld + ! zhao/moorthi's prognostic cloud+pdfcld + elseif(imp_physics == imp_physics_zhao_carr_pdf) then call progcld_zhao_carr_pdf (plyr, plvl, tlyr, tvly, qlyr, & ! --- inputs & qstl, rhly, ccnd(1:IX,1:NLAY,1), cnvw, cnvc, & @@ -660,7 +672,8 @@ subroutine radiation_clouds_prop & & cld_reice,cld_rwp, cld_rerain,cld_swp, & & cld_resnow) - elseif (imp_physics == imp_physics_gfdl) then ! GFDL cloud scheme + ! GFDL cloud scheme + elseif (imp_physics == imp_physics_gfdl) then if (.not. lgfdlmprad) then call progcld_gfdl_lin (plyr, plvl, tlyr, tvly, qlyr, & ! --- inputs @@ -2990,7 +3003,8 @@ subroutine gethml & kstr = NLAY kend = 1 kinc = -1 - else ! input data from sfc to toa + ! input data from sfc to toa + else kstr = 1 kend = NLAY kinc = 1 @@ -3015,7 +3029,8 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) ! save total cloud enddo - elseif ( iovr == iovr_maxrand ) then ! max/ran overlap + ! max/ran overlap + elseif ( iovr == iovr_maxrand ) then do k = kstr, kend, kinc do i = 1, IX @@ -3039,7 +3054,8 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo - elseif ( iovr == iovr_max ) then ! maximum overlap all levels + ! maximum overlap all levels + elseif ( iovr == iovr_max ) then cl1(:) = 0.0 @@ -3060,7 +3076,8 @@ subroutine gethml & clds(i,4) = cl1(i) ! save total cloud enddo - elseif ( iovr == iovr_dcorr ) then ! random if clear-layer divided, + ! random if clear-layer divided, + elseif ( iovr == iovr_dcorr ) then ! otherwise de-corrlength method do i = 1, ix dz1(i) = - dz(i,kstr) @@ -3092,7 +3109,8 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo - elseif ( iovr == iovr_exp .or. iovr == iovr_exprand ) then ! exponential overlap (iovr=4), or + ! exponential overlap (iovr=4), or + elseif ( iovr == iovr_exp .or. iovr == iovr_exprand ) then ! exponential-random (iovr=5); ! distinction defined by alpha @@ -3210,7 +3228,8 @@ subroutine gethml & enddo ! end_do_i_loop enddo ! end_do_k_loop - else ! input data from sfc to toa + ! input data from sfc to toa + else do i = 1, IX cl1 (i) = 0.0 diff --git a/physics/Radiation/radiation_gases.f b/physics/Radiation/radiation_gases.f index 784e8917e..7dcb128f6 100644 --- a/physics/Radiation/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -128,21 +128,34 @@ module module_radiation_gases & VTAGGAS='NCEP-Radiation_gases v5.1 Nov 2012 ' ! & VTAGGAS='NCEP-Radiation_gases v5.0 Aug 2012 ' - integer, parameter, public :: NF_VGAS = 10 ! number of gas species - integer, parameter :: IMXCO2 = 24 ! input CO2 data longitude points - integer, parameter :: JMXCO2 = 12 ! input CO2 data latitude points - integer, parameter :: MINYEAR = 1957 ! earlist year 2D CO2 data available - - real (kind=kind_phys), parameter :: resco2=15.0 ! horizontal resolution in degree - real (kind=kind_phys), parameter :: prsco2=788.0 ! pressure limitation for 2D CO2 (mb) - real (kind=kind_phys) :: raddeg ! rad->deg conversion - real (kind=kind_phys) :: hfpi ! half of pi - - real (kind=kind_phys), parameter :: co2vmr_def = 350.0e-6 ! parameter constant for CO2 volume mixing ratio - real (kind=kind_phys), parameter :: n2ovmr_def = 0.31e-6 ! parameter constant for N2O volume mixing ratio - real (kind=kind_phys), parameter :: ch4vmr_def = 1.50e-6 ! parameter constant for CH4 volume mixing ratio - real (kind=kind_phys), parameter :: o2vmr_def = 0.209 ! parameter constant for O2 volume mixing ratio - real (kind=kind_phys), parameter :: covmr_def = 1.50e-8 ! parameter constant for CO colume mixing ratio + ! number of gas species + integer, parameter, public :: NF_VGAS = 10 + ! input CO2 data longitude points + integer, parameter :: IMXCO2 = 24 + ! input CO2 data latitude points + integer, parameter :: JMXCO2 = 12 + ! earlist year 2D CO2 data available + integer, parameter :: MINYEAR = 1957 + + ! horizontal resolution in degree + real (kind=kind_phys), parameter :: resco2=15.0 + ! pressure limitation for 2D CO2 (mb) + real (kind=kind_phys), parameter :: prsco2=788.0 + ! rad->deg conversion + real (kind=kind_phys) :: raddeg + ! half of pi + real (kind=kind_phys) :: hfpi + + ! parameter constant for CO2 volume mixing ratio + real (kind=kind_phys), parameter :: co2vmr_def = 350.0e-6 + ! parameter constant for N2O volume mixing ratio + real (kind=kind_phys), parameter :: n2ovmr_def = 0.31e-6 + ! parameter constant for CH4 volume mixing ratio + real (kind=kind_phys), parameter :: ch4vmr_def = 1.50e-6 + ! parameter constant for O2 volume mixing ratio + real (kind=kind_phys), parameter :: o2vmr_def = 0.209 + ! parameter constant for CO colume mixing ratio + real (kind=kind_phys), parameter :: covmr_def = 1.50e-8 ! aer 2003 value real (kind=kind_phys), parameter :: f11vmr_def = 3.520e-10 ! aer 2003 value @@ -506,7 +519,8 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & !> - co2 data section - if ( ico2flg == 0 ) return ! use prescribed global mean co2 data + ! use prescribed global mean co2 data + if ( ico2flg == 0 ) return if ( ictmflg ==-1 ) return ! use user provided co2 data if ( .not. ldoco2 ) return ! no need to update co2 data diff --git a/physics/Radiation/radiation_surface.f b/physics/Radiation/radiation_surface.f index 8bbfd6ed5..31472013e 100644 --- a/physics/Radiation/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -118,14 +118,18 @@ module module_radiation_surface ! & VTAGSFC='NCEP-Radiation_surface v5.0 Aug 2012 ' ! --- constant parameters - integer, parameter, public :: IMXEMS = 360 ! number of longtitude points in global emis-type map - integer, parameter, public :: JMXEMS = 180 ! number of latitude points in global emis-type map + ! number of longtitude points in global emis-type map + integer, parameter, public :: IMXEMS = 360 + ! number of latitude points in global emis-type map + integer, parameter, public :: JMXEMS = 180 real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 real (kind=kind_phys), parameter :: epsln = 1.0e-6 real (kind=kind_phys) :: rad2dg - integer, allocatable :: idxems(:,:) ! global surface emissivity index array - integer :: iemslw = 1 ! global surface emissivity control flag set up in 'sfc_init' + ! global surface emissivity index array + integer, allocatable :: idxems(:,:) + ! global surface emissivity control flag set up in 'sfc_init' + integer :: iemslw = 1 ! public sfc_init, setalb, setemis public f_zero, f_one, epsln @@ -952,7 +956,8 @@ subroutine setemis & enddo lab_do_IMAX - elseif ( iemslw == 2 ) then ! sfc emiss updated in land model: Noah MP or RUC + ! sfc emiss updated in land model: Noah MP or RUC + elseif ( iemslw == 2 ) then do i = 1, IMAX diff --git a/physics/SFC_Layer/UFS/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f index e54b29b23..e882e4b42 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -31,8 +31,10 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & logical, intent(in) :: use_lake2m logical, intent(in) :: use_oceanuv logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. - logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics - logical, intent(in) :: diag_log ! Flag for 2-m log diagnostics under stable conditions + ! Flag for flux method in 2-m diagnostics + logical, intent(in) :: diag_flux + ! Flag for 2-m log diagnostics under stable conditions + logical, intent(in) :: diag_log real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1,con_rocp real(kind=kind_phys), intent(in) :: con_karman real(kind=kind_phys), dimension(:), intent( in) :: & diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index fa4cad0d9..2ee5af3d2 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -15,7 +15,8 @@ module sfc_diff private - real (kind=kind_phys), parameter :: ca=0.4_kind_phys ! ca - von karman constant + ! ca - von karman constant + real (kind=kind_phys), parameter :: ca=0.4_kind_phys contains @@ -54,7 +55,8 @@ module sfc_diff !!\f] !! - Calculate the exchange coefficients:\f$cm\f$, \f$ch\f$, and \f$stress\f$ as inputs of other \a sfc schemes. !! - subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) + !intent(in) + subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & & ps,t1,q1,z1,garea,wind, & !intent(in) & prsl1,prslki,prsik1,prslk1, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) @@ -86,17 +88,21 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! integer, parameter :: kp = kind_phys integer, intent(in) :: im, ivegsrc - integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean - logical, intent(in) :: use_oceanuv ! option for including ocean current in the computation of flux + ! option for calculating surface roughness length over ocean + integer, intent(in) :: sfc_z0_type + ! option for including ocean current in the computation of flux + logical, intent(in) :: use_oceanuv integer, dimension(:), intent(in) :: vegtype - logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + ! reduced drag coeff. flag for high wind over sea (j.han) + logical, intent(in) :: redrag logical, dimension(:), intent(in) :: flag_iter, dry, icy logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet - logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + ! Flag for reference pressure in theta calculation + logical, intent(in) :: thsfc_loc real(kind=kind_phys), dimension(:), intent(in) :: u10m,v10m real(kind=kind_phys), dimension(:), intent(in) :: u1,v1 diff --git a/physics/SFC_Models/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f index efb2cb91a..d361698d9 100644 --- a/physics/SFC_Models/Land/Noah/sflx.f +++ b/physics/SFC_Models/Land/Noah/sflx.f @@ -284,28 +284,45 @@ subroutine gfssflx &! --- input ! at the present time, those diverse values are kept temperately to ! provide the same result as the original codes. -- y.t.h. may09 - integer, parameter :: nsold = 4 !< max soil layers + !< max soil layers + integer, parameter :: nsold = 4 ! real (kind=kind_phys), parameter :: gs = con_g !< con_g =9.80665 - real (kind=kind_phys), parameter :: gs1 = 9.8 !< con_g in sfcdif - real (kind=kind_phys), parameter :: gs2 = 9.81 !< con_g in snowpack, frh2o - real (kind=kind_phys), parameter :: tfreez = con_t0c !< con_t0c =273.16 - real (kind=kind_phys), parameter :: lsubc = 2.501e+6 !< con_hvap=2.5000e+6 - real (kind=kind_phys), parameter :: lsubf = 3.335e5 !< con_hfus=3.3358e+5 - real (kind=kind_phys), parameter :: lsubs = 2.83e+6 ! ? in sflx, snopac - real (kind=kind_phys), parameter :: elcp = 2.4888e+3 ! ? in penman + !< con_g in sfcdif + real (kind=kind_phys), parameter :: gs1 = 9.8 + !< con_g in snowpack, frh2o + real (kind=kind_phys), parameter :: gs2 = 9.81 + !< con_t0c =273.16 + real (kind=kind_phys), parameter :: tfreez = con_t0c + !< con_hvap=2.5000e+6 + real (kind=kind_phys), parameter :: lsubc = 2.501e+6 + !< con_hfus=3.3358e+5 + real (kind=kind_phys), parameter :: lsubf = 3.335e5 + ! ? in sflx, snopac + real (kind=kind_phys), parameter :: lsubs = 2.83e+6 + ! ? in penman + real (kind=kind_phys), parameter :: elcp = 2.4888e+3 ! real (kind=kind_phys), parameter :: rd = con_rd ! con_rd =287.05 - real (kind=kind_phys), parameter :: rd1 = 287.04 ! con_rd in sflx, penman, canres - real (kind=kind_phys), parameter :: cp = con_cp ! con_cp =1004.6 - real (kind=kind_phys), parameter :: cp1 = 1004.5 ! con_cp in sflx, canres - real (kind=kind_phys), parameter :: cp2 = 1004.0 ! con_cp in htr + ! con_rd in sflx, penman, canres + real (kind=kind_phys), parameter :: rd1 = 287.04 + ! con_cp =1004.6 + real (kind=kind_phys), parameter :: cp = con_cp + ! con_cp in sflx, canres + real (kind=kind_phys), parameter :: cp1 = 1004.5 + ! con_cp in htr + real (kind=kind_phys), parameter :: cp2 = 1004.0 ! real (kind=kind_phys), parameter :: cph2o = con_cliq ! con_cliq=4.1855e+3 - real (kind=kind_phys), parameter :: cph2o1 = 4.218e+3 ! con_cliq in penman, snopac - real (kind=kind_phys), parameter :: cph2o2 = 4.2e6 ! con_cliq in hrt *unit diff! - real (kind=kind_phys), parameter :: cpice = con_csol ! con_csol=2.106e+3 - real (kind=kind_phys), parameter :: cpice1 = 2.106e6 ! con_csol in hrt *unit diff! + ! con_cliq in penman, snopac + real (kind=kind_phys), parameter :: cph2o1 = 4.218e+3 + ! con_cliq in hrt *unit diff! + real (kind=kind_phys), parameter :: cph2o2 = 4.2e6 + ! con_csol=2.106e+3 + real (kind=kind_phys), parameter :: cpice = con_csol + ! con_csol in hrt *unit diff! + real (kind=kind_phys), parameter :: cpice1 = 2.106e6 ! real (kind=kind_phys), parameter :: sigma = con_sbc ! con_sbc=5.6704e-8 - real (kind=kind_phys), parameter :: sigma1 = 5.67e-8 ! con_sbc in penman, nopac, snopac + ! con_sbc in penman, nopac, snopac + real (kind=kind_phys), parameter :: sigma1 = 5.67e-8 ! --- inputs: integer, intent(in) :: nsoil, couple, icein, vegtyp, soiltyp, & @@ -2026,7 +2043,8 @@ subroutine sfcdif real (kind=kind_phys), parameter :: elfc = vkrm*btg real (kind=kind_phys), parameter :: wold = 0.15 real (kind=kind_phys), parameter :: wnew = 1.0-wold - real (kind=kind_phys), parameter :: pihf = 3.14159265/2.0 ! con_pi/2.0 + ! con_pi/2.0 + real (kind=kind_phys), parameter :: pihf = 3.14159265/2.0 real (kind=kind_phys), parameter :: epsu2 = 1.e-4 real (kind=kind_phys), parameter :: epsust = 0.07 diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f index e5f2deae9..6e0aa67dd 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f @@ -136,14 +136,20 @@ subroutine sfc_sice_run & implicit none ! ! - Define constant parameters - integer, parameter :: kmi = 2 !< 2-layer of ice + !< 2-layer of ice + integer, parameter :: kmi = 2 real(kind=kind_phys), parameter :: zero = 0.0_kind_phys real(kind=kind_phys), parameter :: one = 1.0_kind_phys - real(kind=kind_phys), parameter :: himax = 8.0_kind_phys !< maximum ice thickness allowed - real(kind=kind_phys), parameter :: himin = 0.1_kind_phys !< minimum ice thickness required - real(kind=kind_phys), parameter :: hsmax = 2.0_kind_phys !< maximum snow depth allowed - real(kind=kind_phys), parameter :: timin = 173.0_kind_phys !< minimum temperature allowed for snow/ice - real(kind=kind_phys), parameter :: albfw = 0.06_kind_phys !< albedo for lead + !< maximum ice thickness allowed + real(kind=kind_phys), parameter :: himax = 8.0_kind_phys + !< minimum ice thickness required + real(kind=kind_phys), parameter :: himin = 0.1_kind_phys + !< maximum snow depth allowed + real(kind=kind_phys), parameter :: hsmax = 2.0_kind_phys + !< minimum temperature allowed for snow/ice + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys + !< albedo for lead + real(kind=kind_phys), parameter :: albfw = 0.06_kind_phys real(kind=kind_phys), parameter :: dsi = one/0.33_kind_phys real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys @@ -521,22 +527,34 @@ subroutine ice3lay ! ! --- constant parameters: (properties of ice, snow, and seawater) - real (kind=kind_phys), parameter :: ds = 330.0_kind_phys !< snow (ov sea ice) density (kg/m^3) - real (kind=kind_phys), parameter :: dw =1000.0_kind_phys !< fresh water density (kg/m^3) + !< snow (ov sea ice) density (kg/m^3) + real (kind=kind_phys), parameter :: ds = 330.0_kind_phys + !< fresh water density (kg/m^3) + real (kind=kind_phys), parameter :: dw =1000.0_kind_phys real (kind=kind_phys), parameter :: dsdw = ds/dw real (kind=kind_phys), parameter :: dwds = dw/ds - real (kind=kind_phys), parameter :: ks = 0.31_kind_phys !< conductivity of snow (w/mk) - real (kind=kind_phys), parameter :: i0 = 0.3_kind_phys !< ice surface penetrating solar fraction - real (kind=kind_phys), parameter :: ki = 2.03_kind_phys !< conductivity of ice (w/mk) - real (kind=kind_phys), parameter :: di = 917.0_kind_phys !< density of ice (kg/m^3) + !< conductivity of snow (w/mk) + real (kind=kind_phys), parameter :: ks = 0.31_kind_phys + !< ice surface penetrating solar fraction + real (kind=kind_phys), parameter :: i0 = 0.3_kind_phys + !< conductivity of ice (w/mk) + real (kind=kind_phys), parameter :: ki = 2.03_kind_phys + !< density of ice (kg/m^3) + real (kind=kind_phys), parameter :: di = 917.0_kind_phys real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di - real (kind=kind_phys), parameter :: ci = 2054.0_kind_phys !< heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34e5_kind_phys !< latent heat of fusion (j/kg-ice) - real (kind=kind_phys), parameter :: si = 1.0_kind_phys !< salinity of sea ice - real (kind=kind_phys), parameter :: mu = 0.054_kind_phys !< relates freezing temp to salinity - real (kind=kind_phys), parameter :: tfi = -mu*si !< sea ice freezing temp = -mu*salinity - real (kind=kind_phys), parameter :: tfw = -1.8_kind_phys !< tfw - seawater freezing temp (c) + !< heat capacity of fresh ice (j/kg/k) + real (kind=kind_phys), parameter :: ci = 2054.0_kind_phys + !< latent heat of fusion (j/kg-ice) + real (kind=kind_phys), parameter :: li = 3.34e5_kind_phys + !< salinity of sea ice + real (kind=kind_phys), parameter :: si = 1.0_kind_phys + !< relates freezing temp to salinity + real (kind=kind_phys), parameter :: mu = 0.054_kind_phys + !< sea ice freezing temp = -mu*salinity + real (kind=kind_phys), parameter :: tfi = -mu*si + !< tfw - seawater freezing temp (c) + real (kind=kind_phys), parameter :: tfw = -1.8_kind_phys real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001_kind_phys real (kind=kind_phys), parameter :: dici = di*ci real (kind=kind_phys), parameter :: dili = di*li