From 99ac1a07c34926adf6e5ac03d59138e7a073a6fe Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 4 Mar 2020 00:48:54 +0000 Subject: [PATCH 01/97] updating cycle to distingush lakes from ocean --- physics/gcycle.F90 | 8 + physics/sfcsub.F | 947 ++++++++++++++++++++++++--------------------- 2 files changed, 518 insertions(+), 437 deletions(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index bb1730fc2..b6c085a29 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -62,6 +62,8 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) STCFC1 (Model%nx*Model%ny*Model%lsoil), & SLCFC1 (Model%nx*Model%ny*Model%lsoil) + logical :: lake(Model%nx*Model%ny) + character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi real(kind=kind_phys) :: sig1t, dt_warm @@ -151,6 +153,11 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ELSE AISFCS(len) = 0. ENDIF + if (Sfcprop(nb)%lakefrac(ix) > 0.0) then + lake(len) = .true. + else + lake(len) = .false. + endif ! if (Model%me .eq. 0) ! & print *,' len=',len,' rla=',rla(len),' rlo=',rlo(len) @@ -185,6 +192,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) CVBFCS, CVTFCS, Model%me, Model%nlunit, & size(Model%input_nml_file), & Model%input_nml_file, & + lake, Model%min_lakeice, Model%min_seaice, & Model%ialb, Model%isot, Model%ivegsrc, & trim(tile_num_ch), i_index, j_index) #ifndef INTERNAL_FILE_NML diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 6296e7856..c0bb760f1 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -69,14 +69,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, vegfcs,vetfcs,sotfcs,alffcs & &, cvfcs,cvbfcs,cvtfcs,me,nlunit & &, sz_nml,input_nml_file & + &, lake, min_lakeice, min_seaice & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) ! use machine , only : kind_io8,kind_io4 use sfccyc_module implicit none - character(len=*), intent(in) :: tile_num_ch - integer,intent(in) :: i_index(len), j_index(len) - logical use_ufo, nst_anl + character(len=*), intent(in) :: tile_num_ch + integer, intent(in) :: i_index(len), j_index(len) + logical, intent(in) :: use_ufo, nst_anl + logical, intent(in) :: lake(len) + real (kind=kind_io8), intent(in) :: min_lakeice, min_seaice + real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, & & orolmx,orolmn,oroomx,oroomn,orosmx, & & orosmn,oroimx,oroimn,orojmx,orojmn, & @@ -87,7 +91,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & snolmx,snolmn,snoomx,snoomn,snosmx, & & snosmn,snoimx,snoimn,snojmx,snojmn, & & zorlmx,zorlmn,zoromx,zoromn,zorsmx, & - & zorsmn,zorimx,zorimn,zorjmx, zorjmn, & + & zorsmn,zorimx,zorimn,zorjmx,zorjmn, & & plrlmx,plrlmn,plromx,plromn,plrsmx, & & plrsmn,plrimx,plrimn,plrjmx,plrjmn, & & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, & @@ -284,8 +288,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & sihsmx=8.0,sihsmn=0.0,sihimx=8.0,sihimn=0.10, ! & sihjmx=8.0,sihjmn=0.10,glacir_hice=3.0) parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0, - & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15, - & sicjmx=1.0,sicjmn=0.15) + & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicjmx=1.0) +! & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15, +! & sicjmx=1.0,sicjmn=0.15) parameter(wetlmx=0.15,wetlmn=0.00,wetomx=0.15,wetomn=0.15, & wetsmx=0.15,wetsmn=0.15,wetimx=0.15,wetimn=0.15, @@ -447,34 +452,34 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! climatology surface fields (last character 'c' or 'clm' indicate climatology) ! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, & - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, & - & fnvegc,fnvetc,fnsotc & + character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc & + &, fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc & + &, fnvegc,fnvetc,fnsotc & &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2 - real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len), & - & zorclm(len), albclm(len,4), aisclm(len), & - & tg3clm(len), acnclm(len), cnpclm(len), & - & cvclm (len), cvbclm(len), cvtclm(len), & - & scvclm(len), tsfcl2(len), vegclm(len), & - & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len), & - & smcclm(len,lsoil), stcclm(len,lsoil) & + real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len) & + &, zorclm(len), albclm(len,4), aisclm(len) & + &, tg3clm(len), acnclm(len), cnpclm(len) & + &, cvclm (len), cvbclm(len), cvtclm(len) & + &, scvclm(len), tsfcl2(len), vegclm(len) & + &, vetclm(len), sotclm(len), alfclm(len,2), sliclm(len) & + &, smcclm(len,lsoil), stcclm(len,lsoil) & &, sihclm(len), sicclm(len) & &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len) ! ! analyzed surface fields (last character 'a' or 'anl' indicate analysis) ! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, & - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, & - & fnvega,fnveta,fnsota & - &, fnvmna,fnvmxa,fnslpa,fnabsa -! - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), & - & zoranl(len), albanl(len,4), aisanl(len), & - & tg3anl(len), acnanl(len), cnpanl(len), & - & cvanl (len), cvbanl(len), cvtanl(len), & - & scvanl(len), tsfan2(len), veganl(len), & - & vetanl(len), sotanl(len), alfanl(len,2), slianl(len), & - & smcanl(len,lsoil), stcanl(len,lsoil) & + character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa & + &, fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna & + &, fnvega,fnveta,fnsota & + &, fnvmna,fnvmxa,fnslpa,fnabsa +! + real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len) & + &, zoranl(len), albanl(len,4), aisanl(len) & + &, tg3anl(len), acnanl(len), cnpanl(len) & + &, cvanl (len), cvbanl(len), cvtanl(len) & + &, scvanl(len), tsfan2(len), veganl(len) & + &, vetanl(len), sotanl(len), alfanl(len,2), slianl(len) & + &, smcanl(len,lsoil), stcanl(len,lsoil) & &, sihanl(len), sicanl(len) & &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len) ! @@ -482,13 +487,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! predicted surface fields (last characters 'fcs' indicates forecast) ! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), & - & zorfcs(len), albfcs(len,4), aisfcs(len), & - & tg3fcs(len), acnfcs(len), cnpfcs(len), & - & cvfcs (len), cvbfcs(len), cvtfcs(len), & - & slifcs(len), vegfcs(len), & - & vetfcs(len), sotfcs(len), alffcs(len,2), & - & smcfcs(len,lsoil), stcfcs(len,lsoil) & + real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len) & + &, zorfcs(len), albfcs(len,4), aisfcs(len) & + &, tg3fcs(len), acnfcs(len), cnpfcs(len) & + &, cvfcs (len), cvbfcs(len), cvtfcs(len) & + &, slifcs(len), vegfcs(len) & + &, vetfcs(len), sotfcs(len), alffcs(len,2) & + &, smcfcs(len,lsoil), stcfcs(len,lsoil) & &, sihfcs(len), sicfcs(len), sitfcs(len) & &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) & &, swdfcs(len), slcfcs(len,lsoil) @@ -572,8 +577,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! lqcbgs=.true. quality controls input bges file before merging (should have been ! qced in the forecast program) ! - logical ldebug,lqcbgs - logical lprnt + logical :: ldebug, lqcbgs, lprnt + real :: tem ! ! debug only ! @@ -794,7 +799,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & abslmn = .01 abssmn = .01 endif - if(ifp.eq.0) then + if (ifp == 0) then ifp = 1 do k=1,lsoil fsmcl(k) = 99999. @@ -811,15 +816,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & #endif ! write(6,namsfc) ! - if (me .eq. 0) then - print *,'ftsfl,falbl,faisl,fsnol,fzorl=', - & ftsfl,falbl,faisl,fsnol,fzorl - print *,'fsmcl=',fsmcl(1:lsoil) - print *,'fstcl=',fstcl(1:lsoil) - print *,'ftsfs,falbs,faiss,fsnos,fzors=', - & ftsfs,falbs,faiss,fsnos,fzors - print *,'fsmcs=',fsmcs(1:lsoil) - print *,'fstcs=',fstcs(1:lsoil) + if (me == 0) then + print *,' ftsfl,falbl,faisl,fsnol,fzorl=', & + & ftsfl,falbl,faisl,fsnol,fzorl + print *,' fsmcl=',fsmcl(1:lsoil) + print *,' fstcl=',fstcl(1:lsoil) + print *,' ftsfs,falbs,faiss,fsnos,fzors=', & + & ftsfs,falbs,faiss,fsnos,fzors + print *,' fsmcs=',fsmcs(1:lsoil) + print *,' fstcs=',fstcs(1:lsoil) print *,' aislim=',aislim,' sihnew=',sihnew print *,' isot=', isot,' ivegsrc=',ivegsrc endif @@ -838,175 +843,175 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & deltf = deltsfc / 24.0 ! ctsfl=0. !... tsfc over land - if(ftsfl.ge.99999.) ctsfl=1. - if((ftsfl.gt.0.).and.(ftsfl.lt.99999)) ctsfl=exp(-deltf/ftsfl) + if (ftsfl >= 99999.) ctsfl = 1. + if (ftsfl > 0. .and. ftsfl < 99999) ctsfl = exp(-deltf/ftsfl) ! ctsfs=0. !... tsfc over sea - if(ftsfs.ge.99999.) ctsfs=1. - if((ftsfs.gt.0.).and.(ftsfs.lt.99999)) ctsfs=exp(-deltf/ftsfs) + if (ftsfs >= 99999.) ctsfs=1. + if (ftsfs > 0. .and. ftsfs < 99999) ctsfs = exp(-deltf/ftsfs) ! do k=1,lsoil - csmcl(k)=0. !... soilm over land - if(fsmcl(k).ge.99999.) csmcl(k)=1. - if((fsmcl(k).gt.0.).and.(fsmcl(k).lt.99999)) - & csmcl(k)=exp(-deltf/fsmcl(k)) + csmcl(k) = 0. !... soilm over land + if (fsmcl(k) >= 99999.) csmcl(k) = 1. + if (fsmcl(k) > 0. .and. fsmcl(k) < 99999) + & csmcl(k) = exp(-deltf/fsmcl(k)) csmcs(k)=0. !... soilm over sea - if(fsmcs(k).ge.99999.) csmcs(k)=1. - if((fsmcs(k).gt.0.).and.(fsmcs(k).lt.99999)) - & csmcs(k)=exp(-deltf/fsmcs(k)) + if (fsmcs(k) >= 99999.) csmcs(k) = 1. + if (fsmcs(k) > 0. .and. fsmcs(k) < 99999) + & csmcs(k) = exp(-deltf/fsmcs(k)) enddo ! - calbl=0. !... albedo over land - if(falbl.ge.99999.) calbl=1. - if((falbl.gt.0.).and.(falbl.lt.99999)) calbl=exp(-deltf/falbl) + calbl = 0. !... albedo over land + if (falbl >= 99999.) calbl = 1. + if (falbl > 0. .and. falbl < 99999) calbl = exp(-deltf/falbl) ! calfl=0. !... fraction field for albedo over land - if(falfl.ge.99999.) calfl=1. - if((falfl.gt.0.).and.(falfl.lt.99999)) calfl=exp(-deltf/falfl) + if (falfl >= 99999.) calfl = 1. + if (falfl > 0. .and. falfl < 99999) calfl = exp(-deltf/falfl) ! calbs=0. !... albedo over sea - if(falbs.ge.99999.) calbs=1. - if((falbs.gt.0.).and.(falbs.lt.99999)) calbs=exp(-deltf/falbs) + if (falbs >= 99999.) calbs = 1. + if (falbs > 0. .and. falbs < 99999) calbs = exp(-deltf/falbs) ! - calfs=0. !... fraction field for albedo over sea - if(falfs.ge.99999.) calfs=1. - if((falfs.gt.0.).and.(falfs.lt.99999)) calfs=exp(-deltf/falfs) + calfs = 0. !... fraction field for albedo over sea + if (falfs >= 99999.) calfs = 1. + if (falfs > 0. .and. falfs < 99999) calfs = exp(-deltf/falfs) ! - caisl=0. !... sea ice over land - if(faisl.ge.99999.) caisl=1. - if((faisl.gt.0.).and.(faisl.lt.99999)) caisl=1. + caisl = 0. !... sea ice over land + if (faisl >= 99999.) caisl = 1. + if (faisl > 0. .and. faisl < 99999) caisl = 1. ! - caiss=0. !... sea ice over sea - if(faiss.ge.99999.) caiss=1. - if((faiss.gt.0.).and.(faiss.lt.99999)) caiss=1. + caiss = 0. !... sea ice over sea + if (faiss >= 99999.) caiss = 1. + if (faiss > 0. .and. faiss < 99999) caiss = 1. ! - csnol=0. !... snow over land - if(fsnol.ge.99999.) csnol=1. - if((fsnol.gt.0.).and.(fsnol.lt.99999)) csnol=exp(-deltf/fsnol) + csnol = 0. !... snow over land + if (fsnol >= 99999.) csnol = 1. + if (fsnol > 0. .and. fsnol < 99999) csnol = exp(-deltf/fsnol) ! using the same way to bending snow as narr when fsnol is the negative value ! the magnitude of fsnol is the thread to determine the lower and upper bound ! of final swe - if(fsnol.lt.0.)csnol=fsnol + if (fsnol < 0.) csnol = fsnol ! - csnos=0. !... snow over sea - if(fsnos.ge.99999.) csnos=1. - if((fsnos.gt.0.).and.(fsnos.lt.99999)) csnos=exp(-deltf/fsnos) + csnos = 0. !... snow over sea + if (fsnos >= 99999.) csnos = 1. + if (fsnos > 0 .and. fsnos < 99999) csnos = exp(-deltf/fsnos) ! - czorl=0. !... roughness length over land - if(fzorl.ge.99999.) czorl=1. - if((fzorl.gt.0.).and.(fzorl.lt.99999)) czorl=exp(-deltf/fzorl) + czorl = 0. !... roughness length over land + if (fzorl >= 99999.) czorl = 1. + if (fzorl > 0. .and. fzorl < 99999) czorl = exp(-deltf/fzorl) ! - czors=0. !... roughness length over sea - if(fzors.ge.99999.) czors=1. - if((fzors.gt.0.).and.(fzors.lt.99999)) czors=exp(-deltf/fzors) + czors = 0. !... roughness length over sea + if (fzors >= 99999.) czors = 1. + if (fzors > 0. .and. fzors < 99999) czors = exp(-deltf/fzors) ! -! cplrl=0. !... plant resistance over land -! if(fplrl.ge.99999.) cplrl=1. -! if((fplrl.gt.0.).and.(fplrl.lt.99999)) cplrl=exp(-deltf/fplrl) +! cplrl = 0. !... plant resistance over land +! if (fplrl >= 99999.) cplrl = 1. +! if (fplrl > 0. .and. fplrl < 99999) cplrl=exp(-deltf/fplrl) ! -! cplrs=0. !... plant resistance over sea -! if(fplrs.ge.99999.) cplrs=1. -! if((fplrs.gt.0.).and.(fplrs.lt.99999)) cplrs=exp(-deltf/fplrs) +! cplrs = 0. !... plant resistance over sea +! if (fplrs >= 99999.) cplrs = 1. +! if (fplrs > 0. .and. fplrs < 99999) cplrs=exp(-deltf/fplrs) ! do k=1,lsoil - cstcl(k)=0. !... soilt over land - if(fstcl(k).ge.99999.) cstcl(k)=1. - if((fstcl(k).gt.0.).and.(fstcl(k).lt.99999)) - & cstcl(k)=exp(-deltf/fstcl(k)) - cstcs(k)=0. !... soilt over sea - if(fstcs(k).ge.99999.) cstcs(k)=1. - if((fstcs(k).gt.0.).and.(fstcs(k).lt.99999)) - & cstcs(k)=exp(-deltf/fstcs(k)) + cstcl(k) = 0. !... soilt over land + if (fstcl(k) >= 99999.) cstcl(k) = 1. + if (fstcl(k) > 0. .and. fstcl(k) < 99999) & + & cstcl(k) = exp(-deltf/fstcl(k)) + cstcs(k) = 0. !... soilt over sea + if (fstcs(k) >= 99999.) cstcs(k) = 1. + if (fstcs(k) > 0. .and. fstcs(k) < 99999) & + & cstcs(k) = exp(-deltf/fstcs(k)) enddo ! - cvegl=0. !... vegetation fraction over land - if(fvegl.ge.99999.) cvegl=1. - if((fvegl.gt.0.).and.(fvegl.lt.99999)) cvegl=exp(-deltf/fvegl) + cvegl = 0. !... vegetation fraction over land + if (fvegl >= 99999.) cvegl = 1. + if (fvegl > 0. .and. fvegl < 99999) cvegl = exp(-deltf/fvegl) ! - cvegs=0. !... vegetation fraction over sea - if(fvegs.ge.99999.) cvegs=1. - if((fvegs.gt.0.).and.(fvegs.lt.99999)) cvegs=exp(-deltf/fvegs) + cvegs = 0. !... vegetation fraction over sea + if (fvegs >= 99999.) cvegs = 1. + if (fvegs > 0. .and. fvegs < 99999) cvegs = exp(-deltf/fvegs) ! - cvetl=0. !... vegetation type over land - if(fvetl.ge.99999.) cvetl=1. - if((fvetl.gt.0.).and.(fvetl.lt.99999)) cvetl=exp(-deltf/fvetl) + cvetl = 0. !... vegetation type over land + if (fvetl >= 99999.) cvetl = 1. + if (fvetl > 0. .and. fvetl < 99999) cvetl = exp(-deltf/fvetl) ! - cvets=0. !... vegetation type over sea - if(fvets.ge.99999.) cvets=1. - if((fvets.gt.0.).and.(fvets.lt.99999)) cvets=exp(-deltf/fvets) + cvets = 0. !... vegetation type over sea + if (fvets >= 99999.) cvets = 1. + if (fvets > 0. .and. fvets < 99999) cvets = exp(-deltf/fvets) ! - csotl=0. !... soil type over land - if(fsotl.ge.99999.) csotl=1. - if((fsotl.gt.0.).and.(fsotl.lt.99999)) csotl=exp(-deltf/fsotl) + csotl = 0. !... soil type over land + if (fsotl >= 99999.) csotl = 1. + if (fsotl > 0. .and. fsotl < 99999) csotl = exp(-deltf/fsotl) ! - csots=0. !... soil type over sea - if(fsots.ge.99999.) csots=1. - if((fsots.gt.0.).and.(fsots.lt.99999)) csots=exp(-deltf/fsots) + csots = 0. !... soil type over sea + if (fsots >= 99999.) csots = 1. + if (fsots > 0. .and. fsots < 99999) csots = exp(-deltf/fsots) !cwu [+16l]--------------------------------------------------------------- ! - csihl=0. !... sea ice thickness over land - if(fsihl.ge.99999.) csihl=1. - if((fsihl.gt.0.).and.(fsihl.lt.99999)) csihl=exp(-deltf/fsihl) + csihl = 0. !... sea ice thickness over land + if (fsihl >= 99999.) csihl = 1. + if (fsihl > 0. .and. fsihl < 99999) csihl = exp(-deltf/fsihl) ! - csihs=0. !... sea ice thickness over sea - if(fsihs.ge.99999.) csihs=1. - if((fsihs.gt.0.).and.(fsihs.lt.99999)) csihs=exp(-deltf/fsihs) + csihs = 0. !... sea ice thickness over sea + if (fsihs >= 99999.) csihs = 1. + if (fsihs > 0. .and. fsihs < 99999) csihs = exp(-deltf/fsihs) ! - csicl=0. !... sea ice concentration over land - if(fsicl.ge.99999.) csicl=1. - if((fsicl.gt.0.).and.(fsicl.lt.99999)) csicl=exp(-deltf/fsicl) + csicl = 0. !... sea ice concentration over land + if (fsicl >= 99999.) csicl = 1. + if (fsicl > 0. .and. fsicl < 99999) csicl = exp(-deltf/fsicl) ! - csics=0. !... sea ice concentration over sea - if(fsics.ge.99999.) csics=1. - if((fsics.gt.0.).and.(fsics.lt.99999)) csics=exp(-deltf/fsics) + csics = 0. !... sea ice concentration over sea + if (fsics >= 99999.) csics = 1. + if (fsics > 0. .and. fsics < 99999) csics = exp(-deltf/fsics) !clu [+32l]--------------------------------------------------------------- ! - cvmnl=0. !... min veg cover over land - if(fvmnl.ge.99999.) cvmnl=1. - if((fvmnl.gt.0.).and.(fvmnl.lt.99999)) cvmnl=exp(-deltf/fvmnl) + cvmnl = 0. !... min veg cover over land + if (fvmnl >= 99999.) cvmnl = 1. + if (fvmnl > 0. .and. fvmnl < 99999) cvmnl = exp(-deltf/fvmnl) ! - cvmns=0. !... min veg cover over sea - if(fvmns.ge.99999.) cvmns=1. - if((fvmns.gt.0.).and.(fvmns.lt.99999)) cvmns=exp(-deltf/fvmns) + cvmns = 0. !... min veg cover over sea + if (fvmns >= 99999.) cvmns = 1. + if (fvmns > 0. .and. fvmns < 99999) cvmns = exp(-deltf/fvmns) ! - cvmxl=0. !... max veg cover over land - if(fvmxl.ge.99999.) cvmxl=1. - if((fvmxl.gt.0.).and.(fvmxl.lt.99999)) cvmxl=exp(-deltf/fvmxl) + cvmxl = 0. !... max veg cover over land + if (fvmxl >= 99999.) cvmxl = 1. + if (fvmxl > 0. .and. fvmxl < 99999) cvmxl = exp(-deltf/fvmxl) ! - cvmxs=0. !... max veg cover over sea - if(fvmxs.ge.99999.) cvmxs=1. - if((fvmxs.gt.0.).and.(fvmxs.lt.99999)) cvmxs=exp(-deltf/fvmxs) + cvmxs = 0. !... max veg cover over sea + if (fvmxs >= 99999.) cvmxs = 1. + if (fvmxs > 0. .and. fvmxs < 99999) cvmxs = exp(-deltf/fvmxs) ! - cslpl=0. !... slope type over land - if(fslpl.ge.99999.) cslpl=1. - if((fslpl.gt.0.).and.(fslpl.lt.99999)) cslpl=exp(-deltf/fslpl) + cslpl = 0. !... slope type over land + if (fslpl >= 99999.) cslpl = 1. + if (fslpl > 0. .and. fslpl < 99999) cslpl = exp(-deltf/fslpl) ! - cslps=0. !... slope type over sea - if(fslps.ge.99999.) cslps=1. - if((fslps.gt.0.).and.(fslps.lt.99999)) cslps=exp(-deltf/fslps) + cslps = 0. !... slope type over sea + if (fslps >= 99999.) cslps = 1. + if (fslps > 0. .and. fslps < 99999) cslps = exp(-deltf/fslps) ! - cabsl=0. !... snow albedo over land - if(fabsl.ge.99999.) cabsl=1. - if((fabsl.gt.0.).and.(fabsl.lt.99999)) cabsl=exp(-deltf/fabsl) + cabsl = 0. !... snow albedo over land + if (fabsl >= 99999.) cabsl = 1. + if (fabsl > 0. .and. fabsl < 99999) cabsl = exp(-deltf/fabsl) ! - cabss=0. !... snow albedo over sea - if(fabss.ge.99999.) cabss=1. - if((fabss.gt.0.).and.(fabss.lt.99999)) cabss=exp(-deltf/fabss) + cabss = 0. !... snow albedo over sea + if (fabss >= 99999.) cabss = 1. + if (fabss > 0. .and. fabss < 99999) cabss = exp(-deltf/fabss) !clu ---------------------------------------------------------------------- ! !> - Call hmskrd() to read a high resolution mask field for use in grib interpolation ! - call hmskrd(lugb,imsk,jmsk,fnmskh, + call hmskrd(lugb,imsk,jmsk,fnmskh, & & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me) ! if (qcmsk) call qcmask(slmskh,sllnd,slsea,imsk,jmsk,rla,rlo) ! - if (me .eq. 0) then + if (me == 0) then write(6,*) ' ' write(6,*) ' lugb=',lugb,' len=',len, ' lsoil=',lsoil - write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh - &, ' sig1t(1)=',sig1t(1) + write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh & + &, ' sig1t(1)=',sig1t(1) & &, ' gausm=',gausm,' blnmsk=',blnmsk,' bltmsk=',bltmsk write(6,*) ' ' endif @@ -1114,32 +1119,35 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & !* ice concentration or ice mask (only ice mask used in the model now) ! ice concentration and ice mask (both are used in the model now) ! - if(fnaisc(1:8).ne.' ') then + if(fnaisc(1:8) /= ' ') then !cwu [+5l/-1l] update sihclm, sicclm do i=1,len sihclm(i) = 3.0*aisclm(i) sicclm(i) = aisclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicclm(i) /= 1.0) then sicclm(i) = sicimx sihfcs(i) = glacir_hice endif enddo crit=aislim !* crit=0.5 - call rof01(aisclm,len,'ge',crit) - elseif(fnacnc(1:8).ne.' ') then +! call rof01(aisclm,len,'ge',crit) + call rof01_len(aisclm, len, 'ge', lake, min_lakeice, min_seaice) + + elseif(fnacnc(1:8) /= ' ') then !cwu [+4l] update sihclm, sicclm do i=1,len sihclm(i) = 3.0*acnclm(i) sicclm(i) = acnclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicclm(i).ne.1.) then sicclm(i) = sicimx sihfcs(i) = glacir_hice endif enddo - call rof01(acnclm,len,'ge',aislim) +! call rof01(acnclm,len,'ge',aislim) + call rof01_len(acnclm, len, 'ge', lake, min_lakeice, min_seaice) do i=1,len aisclm(i) = acnclm(i) enddo @@ -1153,6 +1161,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! set ocean/land/sea-ice mask ! call setlsi(slmask,aisclm,len,aicice,sliclm) + ! if(lprnt) print *,' aisclm=',aisclm(iprnt),' sliclm=' ! *,sliclm(iprnt),' slmask=',slmask(iprnt) ! @@ -1170,7 +1179,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! quality control of snow depth (note that snow should be corrected first ! because it influences tsf ! - kqcm=1 + kqcm = 1 call qcmxmn('snow ',snoclm,sliclm,snoclm,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, & snojmx,snojmn,snosmx,snosmn,epssno, @@ -1194,7 +1203,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! quality control ! do i=1,len - icefl2(i) = sicclm(i) .gt. 0.99999 + icefl2(i) = sicclm(i) > 0.99999 enddo kqcm=1 call qcmxmn('tsfc ',tsfclm,sliclm,snoclm,icefl2, @@ -1246,7 +1255,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcclm(3:4) - if(lsoil.gt.2) then + if(lsoil > 2) then call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1256,7 +1265,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) endif - if(fnstcc(1:8).eq.' ') then + if(fnstcc(1:8) == ' ') then call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1, @@ -1268,7 +1277,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcclm(3:4) - if(lsoil.gt.2) then + if(lsoil > 2) then call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, @@ -1295,10 +1304,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, @@ -1321,7 +1330,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! monitoring prints ! if (monclm) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of time and space interpolated climatology' print *,' ' @@ -1371,7 +1380,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif ! ! - if (me .eq. 0) then + if (me == 0) then write(6,*) '==============' write(6,*) ' analysis' write(6,*) '==============' @@ -1395,9 +1404,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! reverse scaling to match with grib analysis input ! - zsca=0.01 + zsca = 0.01 call scale(zoranl,len, zsca) - zsca=100. + zsca = 100. call scale(albanl,len,zsca) call scale(albanl(1,2),len,zsca) call scale(albanl(1,3),len,zsca) @@ -1405,12 +1414,12 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call scale(alfanl,len,zsca) call scale(alfanl(1,2),len,zsca) !clu [+4l] reverse scale for vmn, vmx, abs - zsca=100. + zsca = 100. call scale(vmnanl,len,zsca) call scale(vmxanl,len,zsca) call scale(absanl,len,zsca) ! - percrit=critp2 + percrit = critp2 ! ! read analysis fields ! @@ -1438,9 +1447,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! scale zor and alb to match forecast model units ! - zsca=100. + zsca = 100. call scale(zoranl,len, zsca) - zsca=0.01 + zsca = 0.01 call scale(albanl,len,zsca) call scale(albanl(1,2),len,zsca) call scale(albanl(1,3),len,zsca) @@ -1448,7 +1457,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call scale(alfanl,len,zsca) call scale(alfanl(1,2),len,zsca) !clu [+4] scale vmn, vmx, abs from percent to fraction - zsca=0.01 + zsca = 0.01 call scale(vmnanl,len,zsca) call scale(vmxanl,len,zsca) call scale(absanl,len,zsca) @@ -1470,42 +1479,48 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! ice concentration or ice mask (only ice mask used in the model now) ! - if(fnaisa(1:8).ne.' ') then + if(fnaisa(1:8) /= ' ') then !cwu [+5l/-1l] update sihanl, sicanl do i=1,len sihanl(i) = 3.0*aisanl(i) sicanl(i) = aisanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicanl(i) /= 1.) then sicanl(i) = sicimx sihfcs(i) = glacir_hice endif enddo - crit=aislim +! crit=aislim !* crit=0.5 - call rof01(aisanl,len,'ge',crit) - elseif(fnacna(1:8).ne.' ') then +! call rof01(aisanl,len,'ge',crit) + call rof01_len(aisanl, len, 'ge', lake, min_lakeice, min_seaice) + elseif(fnacna(1:8) /= ' ') then !cwu [+17l] update sihanl, sicanl do i=1,len sihanl(i) = 3.0*acnanl(i) sicanl(i) = acnanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicanl(i) /= 1.) then sicanl(i) = sicimx sihfcs(i) = glacir_hice endif enddo - crit=aislim +! crit=aislim do i=1,len - if((slianl(i).eq.0.).and.(sicanl(i).ge.crit)) then - slianl(i)=2. + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (nint(slianl(i)) == 0 .and. sicanl(i) >= crit) then + slianl(i) = 2. ! print *,'cycle - new ice form: fice=',sicanl(i) - else if((slianl(i).ge.2.).and.(sicanl(i).lt.crit)) then - slianl(i)=0. + elseif (nint(slianl(i)) >= 2 .and. sicanl(i) < crit) then + slianl(i) = 0. ! print *,'cycle - ice free: fice=',sicanl(i) - else if((slianl(i).eq.1.).and.(sicanl(i).ge.sicimn)) then + elseif (nint(slianl(i)) == 1 .and. sicanl(i) > crit) then ! print *,'cycle - land covered by sea-ice: fice=',sicanl(i) - sicanl(i)=0. + sicanl(i) = 0. endif enddo ! znnt=10. @@ -1516,9 +1531,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & .and. aisfcs(i) .ge. 0.75) acnanl(i) = aislim ! enddo ! if(lprnt) print *,' acnanl=',acnanl(iprnt) - call rof01(acnanl,len,'ge',aislim) +! call rof01(acnanl,len,'ge',aislim) + call rof01_len(acnanl, len, 'ge', lake, min_lakeice, min_seaice) do i=1,len - aisanl(i)=acnanl(i) + aisanl(i) = acnanl(i) enddo endif ! if(lprnt) print *,' aisanl1=',aisanl(iprnt),' glacir=' @@ -1551,10 +1567,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) ! ! set albedo over ocean to albomx ! @@ -1563,13 +1579,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! quality control of snow and sea-ice ! process snow depth or snow cover ! - if(fnsnoa(1:8).ne.' ') then + if(fnsnoa(1:8) /= ' ') then call setzro(snoanl,epssno,len) call qcsnow(snoanl,slmask,aisanl,glacir,len,ten,landice,me) if (.not.landice) then call snodpth2(glacir,snosmx,snoanl, len, me) endif - kqcm=1 + kqcm = 1 call snosfc(snoanl,tsfanl,tsfsmx,len,me) call qcmxmn('snoa ',snoanl,slianl,snoanl,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, @@ -1581,7 +1597,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & scvjmx,scvjmn,scvsmx,scvsmn,epsscv, & rla,rlo,len,kqcm,percrit,lgchek,me) else - crit=0.5 + crit = 0.5 call rof01(scvanl,len,'ge',crit) call qcsnow(scvanl,slmask,aisanl,glacir,len,one,landice,me) call qcmxmn('sncva ',scvanl,slianl,scvanl,icefl1, @@ -1599,7 +1615,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif ! do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 + icefl2(i) = sicanl(i) > 0.99999 enddo call qcmxmn('tsfa ',tsfanl,slianl,snoanl,icefl2, & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, @@ -1634,7 +1650,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! get soil temp and moisture ! - if(fnsmca(1:8).eq.' ' .and. fnsmcc(1:8).eq.' ') then + if(fnsmca(1:8) == ' ' .and. fnsmcc(1:8) == ' ') then call getsmc(wetanl,len,lsoil,smcanl,me) endif call qcmxmn('smc1a ',smcanl(1,1),slianl,snoanl,icefl1, @@ -1646,7 +1662,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then + if(lsoil > 2) then call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1656,7 +1672,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) endif - if(fnstca(1:8).eq.' ') then + if(fnstca(1:8) == ' ') then call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif call qcmxmn('stc1a ',stcanl(1,1),slianl,snoanl,icefl1, @@ -1668,7 +1684,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then + if(lsoil > 2) then call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, @@ -1712,7 +1728,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! monitoring prints ! if (monanl) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of time and space interpolated analysis' print *,' ' @@ -1761,20 +1777,20 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! read in forecast fields if needed ! - if (me .eq. 0) then + if (me == 0) then write(6,*) '==============' write(6,*) ' fcst guess' write(6,*) '==============' endif ! - percrit=critp2 + percrit = critp2 ! if(deads) then ! ! fill in guess array with analysis if dead start. ! percrit=critp3 - if (me .eq. 0) write(6,*) 'this run is dead start run' + if (me == 0) write(6,*) 'this run is dead start run' call filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & tg3fcs,cvfcs ,cvbfcs,cvtfcs, & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, @@ -1792,13 +1808,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & !clu [+1l] add ()anl for vmn, vmx, slp, abs & vmnanl,vmxanl,slpanl,absanl, & len,lsoil) - if(sig1t(1).ne.0.) then + if(sig1t(1) /= 0.) then call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs, & tsfimx) do i=1,len - icefl2(i) = sicfcs(i) .gt. 0.99999 + icefl2(i) = sicfcs(i) > 0.99999 enddo - kqcm=1 + kqcm = 1 call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2, & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, @@ -1813,7 +1829,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & rla,rlo,len,kqcm,percrit,lgchek,me) endif else - percrit=critp2 + percrit = critp2 ! ! make reverse angulation correction to tsf ! make reverse orography correction to tg3 @@ -1841,23 +1857,23 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! compute soil moisture liquid-to-total ratio over land ! do j=1, lsoil - do i=1, len - if(smcfcs(i,j) .ne. 0.) then - swratio(i,j) = slcfcs(i,j)/smcfcs(i,j) - else - swratio(i,j) = -999. - endif - enddo + do i=1, len + if(smcfcs(i,j) /= 0.) then + swratio(i,j) = slcfcs(i,j)/smcfcs(i,j) + else + swratio(i,j) = -999. + endif + enddo enddo !clu ----------------------------------------------------------------------- ! - if(lqcbgs .and. irtacn .eq. 0) then + if(lqcbgs .and. irtacn == 0) then call qcsli(slianl,slifcs,len,me) call albocn(albfcs,slmask,albomx,len) do i=1,len icefl2(i) = sicfcs(i) .gt. 0.99999 enddo - kqcm=1 + kqcm = 1 call qcmxmn('snof ',snofcs,slifcs,snofcs,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, & snojmx,snojmn,snosmx,snosmn,epssno, @@ -1872,7 +1888,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ' ) & then call qcmxmn('wetf ',wetfcs,slifcs,snofcs,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, @@ -1898,10 +1914,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) call qcmxmn('smc1f ',smcfcs(1,1),slifcs,snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1975,7 +1991,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif ! if (monfcs) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of guess' print *,' ' @@ -2042,14 +2058,14 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! blend climatology and predicted fields ! - if(me .eq. 0) then + if(me == 0) then write(6,*) '==============' write(6,*) ' merging' write(6,*) '==============' endif ! if(lprnt) print *,' tsffcs=',tsffcs(iprnt) ! - percrit=critp3 + percrit = critp3 ! ! merge analysis and forecast. note tg3, ais are not merged ! @@ -2103,9 +2119,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call snosfc(snoanl,tsfanl,tsfsmx,len,me) ! do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 + icefl2(i) = sicanl(i) > 0.99999 enddo - kqcm=0 + kqcm = 0 call qcmxmn('snowm ',snoanl,slianl,snoanl,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, & snojmx,snojmn,snosmx,snosmn,epssno, @@ -2120,8 +2136,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) - & then + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ') then call qcmxmn('wetm ',wetanl,slianl,snoanl,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, & wetjmx,wetjmn,wetsmx,wetsmn,epswet, @@ -2146,8 +2161,16 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc2m ',smcanl(1,2),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then + if(lsoil > 2) then call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, @@ -2156,17 +2179,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2m ',smcanl(1,2),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -2194,10 +2206,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] add vmn, vmx, slp, abs call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, @@ -2217,7 +2229,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & rla,rlo,len,kqcm,percrit,lgchek,me) ! - if(me .eq. 0) then + if(me == 0) then write(6,*) '==============' write(6,*) 'final results' write(6,*) '==============' @@ -2247,7 +2259,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! check the final merged product ! if (monmer) then - if(me .eq. 0) then + if(me == 0) then print *,' ' print *,'monitor of updated surface fields' print *,' (includes angulation correction)' @@ -2331,7 +2343,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! monitoring prints ! - if(me .eq. 0) then + if(me == 0) then print *,' ' print *,'monitor of difference' print *,' (includes angulation correction)' @@ -2424,15 +2436,21 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points - crit=aislim +! crit=aislim do i=1,len sihfcs(i) = sihanl(i) sitfcs(i) = tsffcs(i) - if (slifcs(i).ge.2.) then - if (sicfcs(i).gt.crit) then + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (slifcs(i) >= 2.) then + if (sicfcs(i) > crit) then + tem = 1.0 / sicfcs(i) tsffcs(i) = (sicanl(i)*tsffcs(i) - & + (sicfcs(i)-sicanl(i))*tgice)/sicfcs(i) - sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) / sicfcs(i) + & + (sicfcs(i)-sicanl(i))*tgice) * tem + sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem else tsffcs(i) = tsfanl(i) ! tsffcs(i) = tgice @@ -2442,13 +2460,20 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & sicfcs(i) = sicanl(i) enddo do i=1,len - if (slifcs(i).lt.1.5) then + if (slifcs(i) < 1.5) then sihfcs(i) = 0. sicfcs(i) = 0. sitfcs(i) = tsffcs(i) - else if ((slifcs(i).ge.1.5).and.(sicfcs(i).lt.crit)) then - print *,'warning: check, slifcs and sicfcs', - & slifcs(i),sicfcs(i) + else + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (sicfcs(i) < crit) then + print *,'warning: check, slifcs and sicfcs', & + & slifcs(i),sicfcs(i) + endif endif enddo @@ -2457,29 +2482,29 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! do k=1, lsoil fixratio(k) = .false. - if (fsmcl(k).lt.99999.) fixratio(k) = .true. + if (fsmcl(k) < 99999.) fixratio(k) = .true. enddo - if(me .eq. 0) then - print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil) + if(me == 0) then + print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil) endif do k=1, lsoil if(fixratio(k)) then do i = 1, len - if(swratio(i,k) .eq. -999.) then + if(swratio(i,k) == -999.) then slcfcs(i,k) = smcfcs(i,k) else slcfcs(i,k) = swratio(i,k) * smcfcs(i,k) endif - if (slifcs(i) .ne. 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points. + if (slifcs(i) /= 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points. enddo endif enddo ! set liquid soil moisture to a flag value of 1.0 if (landice) then do i = 1, len - if (slifcs(i) .eq. 1.0 .and. + if (slifcs(i) == 1.0 .and. & nint(vetfcs(i)) == veg_type_landice) then do k=1, lsoil slcfcs(i,k) = 1.0 @@ -2490,13 +2515,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! ensure the consistency between snwdph and sheleg ! - if(fsnol .lt. 99999.) then - if(me .eq. 0) then - print *,'dbgx -- scale snwdph from sheleg' - endif - do i = 1, len - if(slifcs(i).eq.1.) swdfcs(i) = 10.* snofcs(i) - enddo + if(fsnol < 99999.) then + if(me == 0) then + print *,'dbgx -- scale snwdph from sheleg' + endif + do i = 1, len + if(slifcs(i) == 1.) swdfcs(i) = 10.* snofcs(i) + enddo endif ! sea ice model only uses the liquid equivalent depth. @@ -2504,16 +2529,16 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! use the same 3:1 ratio used by ice model. do i = 1, len - if (slifcs(i).ne.1) swdfcs(i) = 3.*snofcs(i) + if (slifcs(i) /= 1) swdfcs(i) = 3.*snofcs(i) enddo do i = 1, len - if(slifcs(i).eq.1.) then - if(snofcs(i).ne.0. .and. swdfcs(i).eq.0.) then - print *,'dbgx --scale snwdph from sheleg', - + i, swdfcs(i), snofcs(i) - swdfcs(i) = 10.* snofcs(i) - endif + if(slifcs(i) == 1.) then + if(snofcs(i) /= 0. .and. swdfcs(i) == 0.) then + print *,'dbgx --scale snwdph from sheleg', + & i, swdfcs(i), snofcs(i) + swdfcs(i) = 10.* snofcs(i) + endif endif enddo ! landice mods - impose same minimum snow depth at @@ -2523,7 +2548,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! after adjustment to terrain. if (landice) then do i = 1, len - if (slifcs(i) .eq. 1.0 .and. + if (slifcs(i) == 1.0 .and. & & nint(vetfcs(i)) == veg_type_landice) then snofcs(i) = max(snofcs(i),100.0) ! in mm swdfcs(i) = max(swdfcs(i),1000.0) ! in mm @@ -4481,43 +4506,43 @@ subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) end !>\ingroup mod_sfcsub - subroutine rof01(aisfld,len,op,crit) + subroutine rof01(aisfld, len, op, crit) use machine , only : kind_io8,kind_io4 implicit none integer i,len real (kind=kind_io8) aisfld(len),crit character*2 op ! - if(op.eq.'ge') then + if(op == 'ge') then do i=1,len - if(aisfld(i).ge.crit) then - aisfld(i)=1. + if(aisfld(i) >= crit) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'gt') then + elseif(op == 'gt') then do i=1,len - if(aisfld(i).gt.crit) then - aisfld(i)=1. + if(aisfld(i) > crit) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'le') then + elseif(op == 'le') then do i=1,len - if(aisfld(i).le.crit) then - aisfld(i)=1. + if(aisfld(i) <= crit) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'lt') then + elseif(op == 'lt') then do i=1,len - if(aisfld(i).lt.crit) then - aisfld(i)=1. + if(aisfld(i) < crit) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo else @@ -4528,6 +4553,61 @@ subroutine rof01(aisfld,len,op,crit) return end +!>\ingroup mod_sfcsub + subroutine rof01_len(aisfld, len, op, lake, critl, crits) + use machine , only : kind_io8,kind_io4 + implicit none + integer i,len + logical :: lake(len) + real (kind=kind_io8) aisfld(len), critl, crits, crit(len) + character*2 op +! + do i=1,len + if (lake(i)) then + crit(i) = critl + else + crit(i) = crits + endif + enddo + if(op == 'ge') then + do i=1,len + if(aisfld(i) >= crit(i)) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'gt') then + do i=1,len + if(aisfld(i) > crit(i)) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'le') then + do i=1,len + if(aisfld(i) <= crit(i)) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'lt') then + do i=1,len + if(aisfld(i) < crit(i)) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + else + write(6,*) ' illegal operator in rof01. op=',op + call abort + endif +! + return + end !>\ingroup mod_sfcsub subroutine tsfcor(tsfc,orog,slmask,umask,len,rlapse) ! @@ -5215,7 +5295,7 @@ subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, & ! ! check sea-ice cover mask against land-sea mask ! - if (me .eq. 0) write(6,*) 'qc of sea ice' + if (me == 0) write(6,*) 'qc of sea ice' kount = 0 kount1 = 0 do i=1,len @@ -5315,9 +5395,8 @@ subroutine setlsi(slmask,aisfld,len,aicice,slifld) ! do i=1,len slifld(i) = slmask(i) -! if(aisfld(i).eq.aicice) slifld(i) = 2.0 - if(aisfld(i).eq.aicice .and. slmask(i) .eq. 0.0) - & slifld(i) = 2.0 + if(aisfld(i) == aicice .and. slmask(i) == 0.0) + & slifld(i) = 2.0 enddo return end @@ -5342,59 +5421,56 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! use machine , only : kind_io8,kind_io4 implicit none - real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn, & - & fldlmx,fldlmn,fldomx,fldjmn,percrit, & - & fldsmx,fldsmn,epsfld - integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj, & - & ij,nprt,kmaxs,kmins,i,me,len,mode - parameter(mmprt=2) + integer, intent(in) :: len, mode, me + real (kind=kind_io8), intent(in) :: fldimx,fldimn,fldjmx,fldomn, & + & fldlmx,fldlmn,fldomx,fldjmn, & + & fldsmx,fldsmn,epsfld,percrit & + integer, parameter :: mmprt=2 ! character*8 ttl logical iceflg(len) - real (kind=kind_io8) fld(len),slimsk(len),sno(len), & - & rla(len), rlo(len) - integer iwk(len) + real (kind=kind_io8), dimension(len) :: fld, slimsk, sno, rla, rlo logical lgchek ! logical first integer num_threads + real (kind=kind_io8) permax, per data first /.true./ save num_threads, first ! - integer len_thread_m, i1_t, i2_t, it - integer num_parthds + integer :: len_thread_m, i1_t, i2_t, it, num_parthds, & + & kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,kminj, & + & ij,nprt,kmaxs,kmins,i + integer :: islimsk(len), iwk(len) ! if (first) then num_threads = num_parthds() first = .false. endif + do it=1,len + islimsk(it) = nint(slimsk(it)) + enddo ! ! check against land-sea mask and ice cover mask ! - if(me .eq. 0) then -! print *,' ' - print *,'performing qc of ',ttl,' mode=',mode, - & '(0=count only, 1=replace)' + if(me == 0) then + print *,'performing qc of ',ttl,' mode=',mode, + & '(0=count only, 1=replace)' endif ! len_thread_m = (len+num_threads-1) / num_threads - kmaxl = 0 - kminl = 0 - kmaxo = 0 - kmino = 0 - kmaxi = 0 - kmini = 0 - kmaxj = 0 - kminj = 0 - kmaxs = 0 - kmins = 0 + + kmaxl = 0 ; kminl = 0 ; kmaxo = 0 ; kmino = 0 + kmaxi = 0 ; kmini = 0 ; kmaxj = 0 ; kminj = 0 + kmaxs = 0 ; kmins = 0 + !$omp parallel do private(i1_t,i2_t,it,i) !$omp+private(nprt,ij,iwk) !$omp+reduction(+:kmaxs,kmins,kmaxl,kminl,kmaxo) !$omp+reduction(+:kmino,kmaxi,kmini,kmaxj,kminj) !$omp+shared(mode,epsfld) !$omp+shared(fldlmx,fldlmn,fldomx,fldjmn,fldsmx,fldsmn) -!$omp+shared(fld,slimsk,sno,rla,rlo) +!$omp+shared(fld,islimsk,sno,rla,rlo) do it=1,num_threads ! start of threaded loop i1_t = (it-1)*len_thread_m+1 i2_t = min(i1_t+len_thread_m-1,len) @@ -5403,24 +5479,24 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! lower bound check over bare land ! - if (fldlmn .ne. 999.0) then + if (fldlmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).lt.fldlmn-epsfld) then - kminl=kminl+1 + if(islimsk(i) == 1 .and. sno(i) <= 0.0 & + & .and. fld(i) < fldlmn-epsfld) then + kminl = kminl + 1 iwk(kminl) = i endif enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then + if(me == 0 .and. it == 1 .and. num_threads == 1) then nprt = min(mmprt,kminl) do i=1,nprt ij = iwk(i) print 8001,rla(ij),rlo(ij),fld(ij),fldlmn - 8001 format(' bare land min. check. lat=',f5.1, + 8001 format(' bare land min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kminl fld(iwk(i)) = fldlmn enddo @@ -5429,11 +5505,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! upper bound check over bare land ! - if (fldlmx .ne. 999.0) then + if (fldlmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).gt.fldlmx+epsfld) then - kmaxl=kmaxl+1 + if(islimsk(i) == 1 .and. sno(i) <= 0.0 & + & .and. fld(i) > fldlmx+epsfld) then + kmaxl = kmaxl + 1 iwk(kmaxl) = i endif enddo @@ -5442,11 +5518,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8002,rla(ij),rlo(ij),fld(ij),fldlmx - 8002 format(' bare land max. check. lat=',f5.1, + 8002 format(' bare land max. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxl fld(iwk(i)) = fldlmx enddo @@ -5455,11 +5531,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! lower bound check over snow covered land ! - if (fldsmn .ne. 999.0) then + if (fldsmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).lt.fldsmn-epsfld) then - kmins=kmins+1 + if(islimsk(i) == 1 .and. sno(i) > 0.0 & + & .and. fld(i) < fldsmn-epsfld) then + kmins = kmins + 1 iwk(kmins) = i endif enddo @@ -5468,11 +5544,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8003,rla(ij),rlo(ij),fld(ij),fldsmn - 8003 format(' sno covrd land min. check. lat=',f5.1, + 8003 format(' sno covrd land min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmins fld(iwk(i)) = fldsmn enddo @@ -5481,11 +5557,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! upper bound check over snow covered land ! - if (fldsmx .ne. 999.0) then + if (fldsmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).gt.fldsmx+epsfld) then - kmaxs=kmaxs+1 + if(islimsk(i) == 1 .and. sno(i) > 0.0 & + & .and. fld(i) > fldsmx+epsfld) then + kmaxs = kmaxs + 1 iwk(kmaxs) = i endif enddo @@ -5494,11 +5570,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8004,rla(ij),rlo(ij),fld(ij),fldsmx - 8004 format(' snow land max. check. lat=',f5.1, + 8004 format(' snow land max. check. lat=',f5.1,i & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxs fld(iwk(i)) = fldsmx enddo @@ -5507,11 +5583,10 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! lower bound check over open ocean ! - if (fldomn .ne. 999.0) then + if (fldomn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.0..and. - & fld(i).lt.fldomn-epsfld) then - kmino=kmino+1 + if(islimsk(i) == 0.0 .and. fld(i) < fldomn-epsfld) then + kmino = kmino + 1 iwk(kmino) = i endif enddo @@ -5520,11 +5595,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8005,rla(ij),rlo(ij),fld(ij),fldomn - 8005 format(' open ocean min. check. lat=',f5.1, + 8005 format(' open ocean min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4,' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmino fld(iwk(i)) = fldomn enddo @@ -5533,24 +5608,23 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! upper bound check over open ocean ! - if (fldomx .ne. 999.0) then + if (fldomx /= 999.0) then do i=i1_t,i2_t - if(fldomx.ne.999..and.slimsk(i).eq.0..and. - & fld(i).gt.fldomx+epsfld) then - kmaxo=kmaxo+1 + if(islimsk(i) ==.0 .and. fld(i) > fldomx+epsfld) then + kmaxo = kmaxo+1 iwk(kmaxo) = i endif enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then + if(me == 0 .and. it == 1 .and. num_threads == 1) then nprt = min(mmprt,kmaxo) do i=1,nprt ij = iwk(i) print 8006,rla(ij),rlo(ij),fld(ij),fldomx - 8006 format(' open ocean max. check. lat=',f5.1, + 8006 format(' open ocean max. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxo fld(iwk(i)) = fldomx enddo @@ -5559,11 +5633,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! lower bound check over sea ice without snow ! - if (fldimn .ne. 999.0) then + if (fldimn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).lt.fldimn-epsfld) then - kmini=kmini+1 + if(islimsk(i) == 2 .and. sno(i) <= 0.0 & + & .and. fld(i) < fldimn-epsfld) then + kmini = kmini + 1 iwk(kmini) = i endif enddo @@ -5572,11 +5646,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8007,rla(ij),rlo(ij),fld(ij),fldimn - 8007 format(' seaice no snow min. check lat=',f5.1, + 8007 format(' seaice no snow min. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmini fld(iwk(i)) = fldimn enddo @@ -5585,12 +5659,12 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! upper bound check over sea ice without snow ! - if (fldimx .ne. 999.0) then + if (fldimx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).gt.fldimx+epsfld .and. iceflg(i)) then + if(islimsk(i) == 2 .and. sno(i) <= 0.0 .and. & + & fld(i) > fldimx+epsfld .and. iceflg(i)) then ! & fld(i).gt.fldimx+epsfld) then - kmaxi=kmaxi+1 + kmaxi = kmaxi + 1 iwk(kmaxi) = i endif enddo @@ -5599,11 +5673,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8008,rla(ij),rlo(ij),fld(ij),fldimx - 8008 format(' seaice no snow max. check lat=',f5.1, + 8008 format(' seaice no snow max. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxi fld(iwk(i)) = fldimx enddo @@ -5612,11 +5686,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! lower bound check over sea ice with snow ! - if (fldjmn .ne. 999.0) then + if (fldjmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).lt.fldjmn-epsfld) then - kminj=kminj+1 + if(islimsk(i) == 2 .and. sno(i) > 0.0 .and. & + & fld(i) < fldjmn-epsfld) then + kminj = kminj + 1 iwk(kminj) = i endif enddo @@ -5625,11 +5699,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8009,rla(ij),rlo(ij),fld(ij),fldjmn - 8009 format(' sea ice snow min. check lat=',f5.1, + 8009 format(' sea ice snow min. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kminj fld(iwk(i)) = fldjmn enddo @@ -5638,12 +5712,12 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! upper bound check over sea ice with snow ! - if (fldjmx .ne. 999.0) then + if (fldjmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).gt.fldjmx+epsfld .and. iceflg(i)) then + if(islimsk(i) == 2 .and.sno(i) > 0.0 .and. & + & fld(i)> fldjmx+epsfld .and. iceflg(i)) then ! & fld(i).gt.fldjmx+epsfld) then - kmaxj=kmaxj+1 + kmaxj = kmaxj+1 iwk(kmaxj) = i endif enddo @@ -5652,11 +5726,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8010,rla(ij),rlo(ij),fld(ij),fldjmx - 8010 format(' seaice snow max check lat=',f5.1, + 8010 format(' seaice snow max check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxj fld(iwk(i)) = fldjmx enddo @@ -5667,78 +5741,77 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & ! ! print results ! - if(me .eq. 0) then -! write(6,*) 'summary of qc' - permax=0. - if(kminl.gt.0) then - per=float(kminl)/float(len)*100. + if(me == 0) then + permax = 0.0 + if(kminl > 0) then + per = float(kminl)/float(len)*100. print 9001,fldlmn,kminl,per - 9001 format(' bare land min check. modified to ',f8.1, + 9001 format(' bare land min check. modified to ',f8.1, & & ' at ',i5,' points ',f8.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax = per endif - if(kmaxl.gt.0) then - per=float(kmaxl)/float(len)*100. + if(kmaxl > 0) then + per = float(kmaxl)/float(len)*100. print 9002,fldlmx,kmaxl,per - 9002 format(' bare land max check. modified to ',f8.1, + 9002 format(' bare land max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmino.gt.0) then - per=float(kmino)/float(len)*100. + if(kmino > 0) then + per = float(kmino)/float(len)*100. print 9003,fldomn,kmino,per - 9003 format(' open ocean min check. modified to ',f8.1, + 9003 format(' open ocean min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxo.gt.0) then - per=float(kmaxo)/float(len)*100. + if(kmaxo > 0) then + per = float(kmaxo)/float(len)*100. print 9004,fldomx,kmaxo,per - 9004 format(' open sea max check. modified to ',f8.1, + 9004 format(' open sea max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmins.gt.0) then - per=float(kmins)/float(len)*100. + if(kmins >.0) then + per = float(kmins)/float(len)*100. print 9009,fldsmn,kmins,per - 9009 format(' snow covered land min check. modified to ',f8.1, + 9009 format(' snow covered land min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxs.gt.0) then - per=float(kmaxs)/float(len)*100. + if(kmaxs > 0) then + per = float(kmaxs)/float(len)*100. print 9010,fldsmx,kmaxs,per - 9010 format(' snow covered land max check. modified to ',f8.1, + 9010 format(' snow covered land max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmini.gt.0) then - per=float(kmini)/float(len)*100. + if(kmini > 0) then + per = float(kmini)/float(len)*100. print 9005,fldimn,kmini,per - 9005 format(' bare ice min check. modified to ',f8.1, + 9005 format(' bare ice min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxi.gt.0) then - per=float(kmaxi)/float(len)*100. + if(kmaxi > 0) then + per = float(kmaxi)/float(len)*100. print 9006,fldimx,kmaxi,per - 9006 format(' bare ice max check. modified to ',f8.1, + 9006 format(' bare ice max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax=per endif - if(kminj.gt.0) then - per=float(kminj)/float(len)*100. + if(kminj > 0) then + per = float(kminj)/float(len)*100. print 9007,fldjmn,kminj,per - 9007 format(' snow covered ice min check. modified to ',f8.1, + 9007 format(' snow covered ice min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxj.gt.0) then - per=float(kmaxj)/float(len)*100. + if(kmaxj > 0) then + per = float(kmaxj)/float(len)*100. print 9008,fldjmx,kmaxj,per - 9008 format(' snow covered ice max check. modified to ',f8.1, + 9008 format(' snow covered ice max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax=per endif ! commented on 06/30/99 -- moorthi ! if(lgchek) then From f8eb82ca3da1e4dfd8665064998ff02279107002 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 5 Mar 2020 12:39:17 +0000 Subject: [PATCH 02/97] minot changes in sfcsub --- physics/sfcsub.F | 246 +++++++++++++++++++++++------------------------ 1 file changed, 121 insertions(+), 125 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index c0bb760f1..f9c3af1f7 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -67,7 +67,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs & &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs & &, vegfcs,vetfcs,sotfcs,alffcs & - &, cvfcs,cvbfcs,cvtfcs,me,nlunit & + &, cvfcs,cvbfcs,cvtfcs,me,nlunit & &, sz_nml,input_nml_file & &, lake, min_lakeice, min_seaice & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) @@ -152,7 +152,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, sihnew integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, & - & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, & + & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, & & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, & & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, & & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, & @@ -578,7 +578,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! qced in the forecast program) ! logical :: ldebug, lqcbgs, lprnt - real :: tem ! ! debug only ! @@ -842,7 +841,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! deltf = deltsfc / 24.0 ! - ctsfl=0. !... tsfc over land + ctsfl = 0. !... tsfc over land if (ftsfl >= 99999.) ctsfl = 1. if (ftsfl > 0. .and. ftsfl < 99999) ctsfl = exp(-deltf/ftsfl) ! @@ -1256,16 +1255,16 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcclm(3:4) if(lsoil > 2) then - call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif - if(fnstcc(1:8) == ' ') then + if (fnstcc(1:8) == ' ') then call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1, @@ -1277,15 +1276,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcclm(3:4) - if(lsoil > 2) then - call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -1579,7 +1578,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! quality control of snow and sea-ice ! process snow depth or snow cover ! - if(fnsnoa(1:8) /= ' ') then + if (fnsnoa(1:8) /= ' ') then call setzro(snoanl,epssno,len) call qcsnow(snoanl,slmask,aisanl,glacir,len,ten,landice,me) if (.not.landice) then @@ -1627,7 +1626,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) then + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ' ) then call qcmxmn('weta ',wetanl,slianl,snoanl,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, & wetjmx,wetjmn,wetsmx,wetsmn,epswet, @@ -1662,15 +1661,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcanl(3:4) - if(lsoil > 2) then - call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif if(fnstca(1:8) == ' ') then call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) @@ -1684,15 +1683,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcanl(3:4) - if(lsoil > 2) then - call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -1808,7 +1807,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & !clu [+1l] add ()anl for vmn, vmx, slp, abs & vmnanl,vmxanl,slpanl,absanl, & len,lsoil) - if(sig1t(1) /= 0.) then + if (sig1t(1) /= 0.) then call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs, & tsfimx) do i=1,len @@ -1867,7 +1866,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !clu ----------------------------------------------------------------------- ! - if(lqcbgs .and. irtacn == 0) then + if (lqcbgs .and. irtacn == 0) then call qcsli(slianl,slifcs,len,me) call albocn(albfcs,slmask,albomx,len) do i=1,len @@ -1927,15 +1926,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, @@ -1946,15 +1945,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -2006,7 +2005,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('stcfcs1',stcfcs(1,1),slifcs,snofcs,len) call monitr('stcfcs2',stcfcs(1,2),slifcs,snofcs,len) !clu [+4l] add smcfcs(3:4) and stcfcs(3:4) - if(lsoil.gt.2) then + if (lsoil > 2) then call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len) call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len) call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len) @@ -2170,25 +2169,25 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcanl(3:4) - if(lsoil > 2) then - call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif - kqcm=1 + kqcm = 1 call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, @@ -2275,13 +2274,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) !clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) - call monitr('tg3anl',tg3anl,slianl,snoanl,len) - call monitr('zoranl',zoranl,slianl,snoanl,len) + if (lsoil > 2) then + call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) + call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) + call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) + call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) + call monitr('tg3anl',tg3anl,slianl,snoanl,len) + call monitr('zoranl',zoranl,slianl,snoanl,len) endif ! if (gaus) then call monitr('cvaanl',cvanl ,slianl,snoanl,len) @@ -2361,11 +2360,11 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('stcanl1',stcfcs(1,1),slianl,snoanl,len) call monitr('stcanl2',stcfcs(1,2),slianl,snoanl,len) !clu [+4l] add smcfcs(3:4) and stc(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) + if (lsoil > 2) then + call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) + call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) + call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) + call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) endif call monitr('tg3dif',tg3fcs,slianl,snoanl,len) call monitr('zordif',zorfcs,slianl,snoanl,len) @@ -2447,10 +2446,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif if (slifcs(i) >= 2.) then if (sicfcs(i) > crit) then - tem = 1.0 / sicfcs(i) + tem1 = 1.0 / sicfcs(i) tsffcs(i) = (sicanl(i)*tsffcs(i) - & + (sicfcs(i)-sicanl(i))*tgice) * tem - sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem + & + (sicfcs(i)-sicanl(i))*tgice) * tem1 + sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem1 else tsffcs(i) = tsfanl(i) ! tsffcs(i) = tgice @@ -2535,7 +2534,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & do i = 1, len if(slifcs(i) == 1.) then if(snofcs(i) /= 0. .and. swdfcs(i) == 0.) then - print *,'dbgx --scale snwdph from sheleg', + print *,'dbgx --scale snwdph from sheleg', & & i, swdfcs(i), snofcs(i) swdfcs(i) = 10.* snofcs(i) endif @@ -2857,8 +2856,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & !>\ingroup mod_sfcsub !! This subroutine get area of the grib record. - subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr & - &, me) + subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) use machine , only : kind_io8,kind_io4 implicit none integer j,me,kgds11 @@ -3749,7 +3747,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, & & kprvet,kpdsot,kpdalf, & & kpdvmn,kpdvmx,kpdslp,kpdabs, & !clu [+1l] add kpd() for vmn, vmx, slp, abs - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & + & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & !cggg snow mods & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, & & irtvet,irtsot,irtalf & &, irtvmn,irtvmx,irtslp,irtabs & !clu [+1l] add irt() for vmn, vmx, slp, abs @@ -3840,36 +3838,36 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & endif else do i=1,len - tsfan0(i)=-999.9 + tsfan0(i) = -999.9 enddo endif ! ! albedo ! - irtalb=0 + irtalb = 0 if(fnalba(1:8).ne.' ') then do kk = 1, 4 call fixrda(lugb,fnalba,kpdalb(kk),slmask, & iy,im,id,ih,fh,albanl(1,kk),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - irtalb=iret - if(iret.eq.1) then + irtalb = iret + if(iret == 1) then write(6,*) 'albedo analysis read error' call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then + elseif(iret == -1) then + if (me == 0) then print *,'old albedo analysis provided, indicating proper', & ' file name is given. no error suspected.' write(6,*) 'forecast guess will be used' endif else - if (me .eq. 0 .and. kk .eq. 4) + if (me == 0 .and. kk == 4) & print *,'albedo analysis provided.' endif enddo else - if (me .eq. 0) then + if (me == 0) then ! print *,'************************************************' print *,'no albedo analysis available. climatology used' endif @@ -3877,30 +3875,30 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & ! ! vegetation fraction for albedo ! - irtalf=0 + irtalf = 0 if(fnalba(1:8).ne.' ') then do kk = 1, 2 call fixrda(lugb,fnalba,kpdalf(kk),slmask, & iy,im,id,ih,fh,alfanl(1,kk),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - irtalf=iret - if(iret.eq.1) then + irtalf = iret + if(iret == 1) then write(6,*) 'albedo analysis read error' call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then + elseif(iret == -1) then + if (me == 0) then print *,'old albedo analysis provided, indicating proper', & ' file name is given. no error suspected.' write(6,*) 'forecast guess will be used' endif else - if (me .eq. 0 .and. kk .eq. 4) + if (me == 0 .and. kk == 4) & print *,'albedo analysis provided.' endif enddo else - if (me .eq. 0) then + if (me == 0) then ! print *,'************************************************' print *,'no vegfalbedo analysis available. climatology used' endif @@ -5395,7 +5393,7 @@ subroutine setlsi(slmask,aisfld,len,aicice,slifld) ! do i=1,len slifld(i) = slmask(i) - if(aisfld(i) == aicice .and. slmask(i) == 0.0) + if(aisfld(i) == aicice .and. slmask(i) == 0.0) & & slifld(i) = 2.0 enddo return @@ -6069,21 +6067,19 @@ subroutine qcsli(slianl,slifcs,len,me) !>\ingroup mod_sfcsub subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, & & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, & - & zoranl,smcanl, & - & smcclm,tsfsmx,albomx,zoromx, me) + & zoranl,smcanl,smcclm,tsfsmx,albomx,zoromx, me) ! use machine , only : kind_io8,kind_io4 implicit none integer kount,me,k,i,lsoil,len real (kind=kind_io8) zoromx,per,albomx,qctsfi,qcsnos,qctsfs,tsfsmx real (kind=kind_io8) tsffcs(len), snofcs(len) - real (kind=kind_io8) snoanl(len), aisanl(len), - & slianl(len), zoranl(len), - & tsfanl(len), albanl(len,4), - & smcanl(len,lsoil) - real (kind=kind_io8) smcclm(len,lsoil) + real (kind=kind_io8) snoanl(len), aisanl(len), & + & slianl(len), zoranl(len), & + & tsfanl(len), albanl(len,4), & + & smcanl(len,lsoil), smcclm(len,lsoil) ! - if (me .eq. 0) write(6,*) 'qc of snow and sea-ice analysis' + if (me == 0) write(6,*) 'qc of snow and sea-ice analysis' ! ! qc of snow analysis ! @@ -6091,7 +6087,7 @@ subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, & ! kount = 0 do i=1,len - if(slianl(i).gt.0..and. + if(slianl(i).gt.0..and. & & tsffcs(i).gt.qctsfs.and.snoanl(i).gt.0.) then kount = kount + 1 snoanl(i) = 0. From ab6cb5ae9292efe62b1866f62783266d60a11c50 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 10 Mar 2020 19:26:24 +0000 Subject: [PATCH 03/97] correcting errors in ccpp when levr < levs; this fix is essential for Whole Atmosphere Model --- physics/GFS_rrtmg_post.F90 | 12 ++-- physics/GFS_rrtmg_pre.F90 | 138 +++++++++++++++--------------------- physics/GFS_rrtmg_setup.F90 | 4 +- physics/dcyc2.meta | 24 +++---- physics/moninedmf.meta | 12 ++-- physics/rrtmg_lw_post.F90 | 9 ++- physics/rrtmg_lw_pre.F90 | 4 +- physics/rrtmg_sw_post.F90 | 10 +-- physics/rrtmg_sw_pre.F90 | 6 +- physics/satmedmfvdif.meta | 12 ++-- physics/satmedmfvdifq.meta | 12 ++-- physics/ysuvdif.meta | 4 +- 12 files changed, 113 insertions(+), 134 deletions(-) diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index db3de4f44..498138d6c 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -44,12 +44,12 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday real(kind=kind_phys), intent(in) :: raddt - real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp - real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(in) :: cldsa - integer, dimension(size(Grid%xlon,1),3), intent(in) :: mbota, mtopa - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: clouds1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: cldtausw - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: cldtaulw + real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp + real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(in) :: cldsa + integer, dimension(size(Grid%xlon,1),3), intent(in) :: mbota, mtopa + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: clouds1 + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtausw + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtaulw character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index aa1ea039e..679c1afa9 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -85,61 +85,40 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(out) :: kd, kt, kb ! F-A mp scheme only - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: f_ice, & + f_rain, f_rimef + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: cwm + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: delp, & + dz, plyr, tlyr, qlyr, olyr - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: plyr - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: tlvl - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: tlyr - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: tsfg - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: tsfa - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: qlyr - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: olyr - - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_co2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_n2o - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_ch4 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_o2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_co - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_cfc11 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_cfc12 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_cfc22 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_ccl4 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: gasvmr_cfc113 - - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW), intent(out) :: faersw1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW), intent(out) :: faersw2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW), intent(out) :: faersw3 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW), intent(out) :: faerlw1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW), intent(out) :: faerlw2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW), intent(out) :: faerlw3 - - real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: aerodp - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds3 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds4 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds5 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds6 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds7 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds8 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds9 - real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa - integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota - integer, dimension(size(Grid%xlon,1),3), intent(out) :: mtopa - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: alb1d + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+1+LTP), intent(out) :: plvl, tlvl + + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: tsfg, tsfa + + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: gasvmr_co2, & + gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDSW), intent(out) :: faersw1, & + faersw2, faersw3 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDLW), intent(out) :: faerlw1, & + faerlw2, faerlw3 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: aerodp + + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: clouds1, & + clouds2, clouds3, clouds4, clouds5, clouds6, clouds7, clouds8, clouds9 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa + integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota, mtopa + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth, alb1d character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg ! Local variables integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl, ncndl @@ -150,21 +129,21 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db -! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP+1) :: tem2db +! real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP+1) :: hz - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,min(4,Model%ncnd)) :: ccnd + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,2:Model%ntrac) :: tracer1 + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NF_CLDS) :: clouds + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NF_VGAS) :: gasvmr + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDSW,NF_AESW) ::faersw + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDLW,NF_AELW) ::faerlw ! !===> ... begin here ! @@ -175,8 +154,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input if (.not. (Model%lsswr .or. Model%lslwr)) return !--- set commonly used integers - me = Model%me - NFXR = Model%nfxr + me = Model%me + NFXR = Model%nfxr NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC) ntcw = Model%ntcw ntiw = Model%ntiw @@ -209,16 +188,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input llb = 1 ! local index at toa level lya = 2 ! local index for the 2nd layer from top lyb = 1 ! local index for the top layer - endif ! end if_ivflip_block + endif ! end if_ivflip_block else kd = 0 - if ( ivflip == 1 ) then ! vertical from sfc upward + if ( ivflip == 1 ) then ! vertical from sfc upward kt = 1 ! index diff between lyr and upper bound kb = 0 ! index diff between lyr and lower bound - else ! vertical from toa downward + else ! vertical from toa downward kt = 0 ! index diff between lyr and upper bound kb = 1 ! index diff between lyr and lower bound - endif ! end if_ivflip_block + endif ! end if_ivflip_block endif ! end if_lextop_block raddt = min(Model%fhswr, Model%fhlwr) @@ -247,7 +226,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input lsk = 0 if (ivflip == 0 .and. lm < Model%levs) lsk = Model%levs - lm -! convert pressure unit from pa to mb +! convert pressure unit from pa to mb do k = 1, LM k1 = k + kd k2 = k + lsk @@ -275,38 +254,39 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo ! if (ivflip == 0) then ! input data from toa to sfc - do i = 1, IM - plvl(i,1+kd) = 0.01 * Statein%prsi(i,1) ! pa to mb (hpa) - enddo - if (lsk /= 0) then + if (lsk > 0) then + k1 = 1 + kd + k2 = k1 + kb do i = 1, IM - plvl(i,1+kd) = 0.5 * (plvl(i,2+kd) + plvl(i,1+kd)) + plvl(i,k2) = 0.01 * Statein%prsi(i,1+kb) ! pa to mb (hpa) + plyr(i,k1) = 0.5 * (plvl(i,k2+1) + plvl(i,k2)) + prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo endif else ! input data from sfc to top - do i = 1, IM - plvl(i,LP1+kd) = 0.01 * Statein%prsi(i,LP1+lsk) ! pa to mb (hpa) - enddo - if (lsk /= 0) then + if (Model%levs > lm) then + k1 = lm + kd do i = 1, IM - plvl(i,LM+kd) = 0.5 * (plvl(i,LP1+kd) + plvl(i,LM+kd)) + plvl(i,k1+1) = 0.01 * Statein%prsi(i,Model%levs+1) ! pa to mb (hpa) + plyr(i,k1) = 0.5 * (plvl(i,k1+1) + plvl(i,k1)) + prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo endif endif - +! if ( lextop ) then ! values for extra top layer do i = 1, IM plvl(i,llb) = prsmin if ( plvl(i,lla) <= prsmin ) plvl(i,lla) = 2.0*prsmin plyr(i,lyb) = 0.5 * plvl(i,lla) tlyr(i,lyb) = tlyr(i,lya) - prslk1(i,lyb) = (plyr(i,lyb)*0.00001) ** rocp ! plyr in Pa + prslk1(i,lyb) = (plyr(i,lyb)*0.001) ** rocp ! plyr in Pa rhly(i,lyb) = rhly(i,lya) qstl(i,lyb) = qstl(i,lya) enddo ! --- note: may need to take care the top layer amount - tracer1(:,lyb,:) = tracer1(:,lya,:) + tracer1(:,lyb,:) = tracer1(:,lya,:) endif diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index b6d86a34e..b3c91cacc 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -400,7 +400,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! ! ! attributes: ! ! language: fortran 90 ! -! machine: wcoss ! +! machine: wcoss ! ! ! ! ==================== definition of variables ==================== ! ! ! @@ -683,7 +683,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & ! solcon : sun-earth distance adjusted solar constant (w/m2) ! ! ! ! external module variables: ! -! isolar : solar constant cntrl (in module physparam) ! +! isolar : solar constant cntrl (in module physparam) ! ! = 0: use the old fixed solar constant in "physcon" ! ! =10: use the new fixed solar constant in "physcon" ! ! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index c4a8d9051..552264f52 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -183,37 +183,37 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky shortwave heating rate on radiation time step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step - long_name = clear sky shortwave heating rate on radiation time step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate on radiation time step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step - long_name = clear sky longwave heating rate on radiation time step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 47875640f..5d75aea22 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -145,19 +145,19 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky shortwave heating rate + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_on_radiation_timestep + long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index 971b278dd..af83c5cc7 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -30,9 +30,8 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & type(GFS_grid_type), intent(in) :: Grid type(GFS_radtend_type), intent(inout) :: Radtend integer, intent(in) :: im, ltp, LM, kd - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlwc - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlw0 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa + real(kind=kind_phys), dimension(size(Grid%xlon,1), lm+LTP), intent(in) :: htlwc, htlw0 + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! local variables @@ -54,7 +53,7 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & enddo ! --- repopulate the points above levr if (lm < Model%levs) then - do k = lm,Model%levs + do k = lm+1,Model%levs Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM) enddo endif @@ -66,7 +65,7 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & enddo ! --- repopulate the points above levr if (lm < Model%levs) then - do k = lm,Model%levs + do k = lm+1,Model%levs Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM) enddo endif diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 5f128a79a..7de02eed1 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -30,7 +30,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm type(GFS_sfcprop_type), intent(in) :: Sfcprop type(GFS_grid_type), intent(in) :: Grid integer, intent(in) :: im - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -44,7 +44,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & tsfg, tsfa, Sfcprop%hprime(:,1), IM, & - Radtend%semis) ! --- outputs + Radtend%semis) ! --- outputs endif end subroutine rrtmg_lw_pre_run diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index e11491d48..b0ab31129 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -34,9 +34,9 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend type(GFS_grid_type), intent(in) :: Grid type(GFS_diag_type), intent(inout) :: Diag - integer, intent(in) :: im, lm, kd, nday, ltp - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw - real(kind=kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htswc, htsw0 + integer, intent(in) :: im, lm, kd, nday, ltp + type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw + real(kind=kind_phys), dimension(Size(Grid%xlon,1), lm+LTP), intent(in) :: htswc, htsw0 real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -56,7 +56,7 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & ! We are assuming that radiative tendencies are from bottom to top ! --- repopulate the points above levr i.e. LM if (lm < Model%levs) then - do k = lm,Model%levs + do k = lm+1,Model%levs Radtend%htrsw (1:im,k) = Radtend%htrsw (1:im,LM) enddo endif @@ -68,7 +68,7 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & enddo ! --- repopulate the points above levr i.e. LM if (lm < Model%levs) then - do k = lm,Model%levs + do k = lm+1,Model%levs Radtend%swhc(1:im,k) = Radtend%swhc(1:im,LM) enddo endif diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 8eeb16430..05e8d4c7b 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -35,7 +35,7 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & integer, intent(in) :: im integer, intent(out) :: nday integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: alb1d character(len=*), intent(out) :: errmsg @@ -73,12 +73,12 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & Sfcprop%tisfc, IM, & alb1d, Model%pertalb, & ! mg, sfc-perts - sfcalb) ! --- outputs + sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) else - nday = 0 + nday = 0 idxday = 0 sfcalb = 0.0 endif diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 63480e01b..50668d204 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -249,19 +249,19 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky shortwave heating rate + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index ec679faec..6fa8b143b 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -249,19 +249,19 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky shortwave heating rate + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 458ff75ae..12819dee5 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -128,7 +128,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in From 3ba810b49098baa82e30e4e157b31f584022c79e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 30 Mar 2020 15:42:39 -0400 Subject: [PATCH 04/97] a bug fix --- physics/GFS_rrtmg_pre.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 679c1afa9..71f89f305 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -262,6 +262,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input plyr(i,k1) = 0.5 * (plvl(i,k2+1) + plvl(i,k2)) prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo + else + k1 = 1 + kd + do i = 1, IM + plvl(i,k1) = Statein%prsi(i,1) * 0.01 ! pa to mb (hpa) + enddo endif else ! input data from sfc to top if (Model%levs > lm) then @@ -271,6 +276,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input plyr(i,k1) = 0.5 * (plvl(i,k1+1) + plvl(i,k1)) prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo + else + k1 = lp1 + kd + do i = 1, IM + plvl(i,k1) = Statein%prsi(i,lp1) * 0.01 ! pa to mb (hpa) + enddo endif endif ! From f9f34e6862d75d8b3cc6d0fc6776f1e1ddeef716 Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Wed, 1 Apr 2020 13:46:23 +0000 Subject: [PATCH 05/97] updates to old sfc pert team - does not compile --- physics/GFS_MP_generic.meta | 4 +- physics/GFS_debug.F90 | 2 +- physics/GFS_rrtmg_pre.F90 | 13 +++--- physics/GFS_surface_generic.F90 | 74 ++++++++++++++----------------- physics/GFS_surface_generic.meta | 75 ++++++++++---------------------- physics/radiation_surface.f | 6 +-- physics/rrtmg_sw_pre.F90 | 14 +++++- physics/sfc_drv.f | 6 +-- physics/sfc_drv.meta | 4 +- 9 files changed, 87 insertions(+), 111 deletions(-) diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index ddf8cb813..933ba96fe 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -715,8 +715,8 @@ intent = inout optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 6bf39d491..326a4ff57 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -474,7 +474,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if - if (Model%do_sfcperts) then + if (Model%lndp_type .NE. 0) then call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) end if if (Model%do_ca) then diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 381930d49..494dc24b8 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -790,12 +790,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! perturbation size ! --- turn vegetation fraction pattern into percentile pattern alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then - do i=1,im - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + if (Model%lndp_type==1) then + do k =1,Model%n_var_lndp + if (Model%lndp_var_list(k) == 'alb') then + do i=1,im + call cdfnor(Coupling%sfc_wts(i,k),alb1d(i)) + !lndp_alb = Model%lndp_prt_list(k) + enddo + endif enddo - endif endif ! mg, sfc-perts diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index ac366ae54..e303b010f 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -28,14 +28,15 @@ end subroutine GFS_surface_generic_pre_finalize subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & - pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & + drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & + lndp_var_list, lndp_prt_list, & + z01d, zt1d, bexp1d, xlai1d, vegf1d, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) - use surface_perturbation, only: cdfnor + use surface_perturbation, only: cdfnor - implicit none + implicit none ! Interface variables integer, intent(in) :: im, levs, isot, ivegsrc @@ -57,14 +58,11 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: dsnow_cpl real(kind=kind_phys), dimension(im), intent(in) :: rain_cpl real(kind=kind_phys), dimension(im), intent(in) :: snow_cpl - logical, intent(in) :: do_sfcperts - integer, intent(in) :: nsfcpert + integer, intent(in) :: lndp_type + integer, intent(in) :: n_var_lndp + character(len=3), dimension(n_var_lndp), intent(in) :: lndp_var_list + real(kind=kind_phys), dimension(n_var_lndp), intent(in) :: lndp_prt_list real(kind=kind_phys), dimension(im,nsfcpert), intent(in) :: sfc_wts - real(kind=kind_phys), dimension(:), intent(in) :: pertz0 - real(kind=kind_phys), dimension(:), intent(in) :: pertzt - real(kind=kind_phys), dimension(:), intent(in) :: pertshc - real(kind=kind_phys), dimension(:), intent(in) :: pertlai - real(kind=kind_phys), dimension(:), intent(in) :: pertvegf real(kind=kind_phys), dimension(im), intent(out) :: z01d real(kind=kind_phys), dimension(im), intent(out) :: zt1d real(kind=kind_phys), dimension(im), intent(out) :: bexp1d @@ -90,9 +88,9 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, intent(out) :: errflg ! Local variables - integer :: i + integer :: i, k real(kind=kind_phys) :: onebg - real(kind=kind_phys) :: cdfz + real(kind=kind_phys) :: cdfz, lndp_vgf ! Set constants onebg = 1.0/con_g @@ -108,34 +106,28 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Scale random patterns for surface perturbations with perturbation size ! Turn vegetation fraction pattern into percentile pattern - if (do_sfcperts) then - if (pertz0(1) > 0.) then - z01d(:) = pertz0(1) * sfc_wts(:,1) -! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) -! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) - endif - if (pertzt(1) > 0.) then - zt1d(:) = pertzt(1) * sfc_wts(:,2) - endif - if (pertshc(1) > 0.) then - bexp1d(:) = pertshc(1) * sfc_wts(:,3) - endif - if (pertlai(1) > 0.) then - xlai1d(:) = pertlai(1) * sfc_wts(:,4) - endif -! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! -! if (pertalb(1) > 0.) then -! do i=1,im -! call cdfnor(sfc_wts(i,5),cdfz) -! alb1d(i) = cdfz -! enddo -! endif - if (pertvegf(1) > 0.) then - do i=1,im - call cdfnor(sfc_wts(i,6),cdfz) - vegf1d(i) = cdfz - enddo - endif + lndp_vgf=-999. + + if (lndp_type==1) then + do k =1,n_var_lndp + select case(lndp_var_list(k)) + case ('rz0') + z01d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('rzt') + zt1d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('shc') + bexp1d(:) = lndp_prt_list(k) * sfc_wts(:,k) + case ('lai') + xlai1d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('vgf') + ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff + do i=1,im + call cdfnor(sfc_wts(i,k),cdfz) + vegf1d(i) = cdfz + enddo + lndp_vgf = Model%lndp_prt_list(k) + end select + enddo endif ! End of stochastic physics / surface perturbation diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 250f7a2bd..cb90b0c8b 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -183,8 +183,8 @@ intent = inout optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical @@ -235,17 +235,17 @@ kind = kind_phys intent = in optional = F -[do_sfcperts] - standard_name = flag_for_stochastic_surface_perturbations - long_name = flag for stochastic surface perturbations option - units = flag +[lndp_type] + standard_name = index_for_stochastic_land_surface_perturbation_type + long_name = index for stochastic land surface perturbations type + units = index dimensions = () - type = logical + type = integer intent = in optional = F -[nsfcpert] - standard_name = number_of_surface_perturbations - long_name = number of surface perturbations +[n_var_lndp] + standard_name = number_of_land_surface_variables_perturbed + long_name = number of land surface perturbations units = count dimensions = () type = integer @@ -260,51 +260,20 @@ kind = kind_phys intent = in optional = F -[pertz0] - standard_name = magnitude_of_perturbation_of_momentum_roughness_length - long_name = magnitude of perturbation of momentum roughness length - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F -[pertzt] - standard_name = magnitude_of_perturbation_of_heat_to_momentum_roughness_length_ratio - long_name = magnitude of perturbation of heat to momentum roughness length r. - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F -[pertshc] - standard_name = magnitude_of_perturbation_of_soil_type_b_parameter - long_name = magnitude of perturbation of soil type b parameter - units = frac - dimensions = (5) +[lndp_prt_list] + standard_name =magnitude_of_perturbations_for_landperts + long_name = magnitude of perturbations for landperts + units = variable + dimensions = (max_n_var_lndp) type = real kind = kind_phys - intent = in - optional = F -[pertlai] - standard_name = magnitude_of_perturbation_of_leaf_area_index - long_name = magnitude of perturbation of leaf area index - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F -[pertvegf] - standard_name = magnitude_of_perturbation_of_vegetation_fraction - long_name = magnitude of perturbation of vegetation fraction - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F +[lndp_var_list] + standard_name = variables_to_be_perturbed_for_landperts + long_name = variables to be perturbed for landperts + units = none + dimensions = (max_n_var_lndp) + type = character + kind = len=3 [z01d] standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index a2cbf55ac..f0cbdd18a 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -390,7 +390,7 @@ subroutine setalb & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & sncovr, snoalb, albPpert ! sfc-perts, mgehne - real (kind=kind_phys), dimension(5), intent(in) :: pertalb ! sfc-perts, mgehne + real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne ! --- outputs real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & @@ -628,12 +628,12 @@ subroutine setalb & ! sfc-perts, mgehne *** !> - Call ppebet () to perturb all 4 elements of surface albedo sfcalb(:,1:4). - if (pertalb(1)>0.0) then + if (pertalb>0.0) then do i = 1, imax do kk=1, 4 ! compute beta distribution parameters for all 4 albedos m = sfcalb(i,kk) - s = pertalb(1)*m*(1.-m) + s = pertalb*m*(1.-m) alpha = m*m*(1.-m)/(s*s)-m beta = alpha*(1.-m)/m ! compute beta distribution value corresponding diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 8eeb16430..763b204c0 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -44,6 +44,8 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & integer :: i real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + real(kind=kind_phys) :: lndp_alb + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -63,6 +65,16 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & endif enddo +! set albedo pert, if requested. + lndp_alb = -999. + if (Model%lndp_type==1) then + do i =1,Model%n_var_lndp + if (Model%lndp_var_list(i) == 'alb') then + lndp_alb = Model%lndp_prt_list(i) + endif + enddo + endif + !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. @@ -72,7 +84,7 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts + alb1d, lndp_alb, & ! mg, sfc-perts sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 75afaa6ff..d28a9644e 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -207,7 +207,7 @@ subroutine lsm_noah_run & integer, intent(in) :: im, km, isot, ivegsrc real (kind=kind_phys), intent(in) :: grav, cp, hvap, rd, eps, & & epsm1, rvrdm1 - real (kind=kind_phys), dimension(5), intent(in) :: pertvegf + real (kind=kind_phys), intent(in) :: pertvegf integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp @@ -422,10 +422,10 @@ subroutine lsm_noah_run & !! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper !! or lower bound. vegfp = vegfpert(i) ! sfc-perts, mgehne - if (pertvegf(1)>0.0) then + if (pertvegf>0.0) then ! compute beta distribution parameters for vegetation fraction mv = shdfac - sv = pertvegf(1)*mv*(1.-mv) + sv = pertvegf*mv*(1.-mv) alphav = mv*mv*(1.0-mv)/(sv*sv)-mv betav = alphav*(1.0-mv)/mv ! compute beta distribution value corresponding diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 7728ee375..0505c23ae 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -435,11 +435,11 @@ kind = kind_phys intent = in optional = F -[pertvegf] +[lndp_vgf] standard_name = magnitude_of_perturbation_of_vegetation_fraction long_name = magnitude of perturbation of vegetation fraction units = frac - dimensions = (5) + dimensions = () type = real kind = kind_phys intent = in From 90dfcc16763f6a3f6dd63a46fb4ce434f9946b2d Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Wed, 1 Apr 2020 13:46:23 +0000 Subject: [PATCH 06/97] updates to old sfc pert team - does not compile --- physics/GFS_stochastics.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 9232c8d6a..70a9764ae 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -18,8 +18,8 @@ intent = in optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical From 1f096f3a0379e087f454bf504c2a3e8b61c01453 Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Wed, 8 Apr 2020 20:57:21 +0000 Subject: [PATCH 07/97] Phil's ccpp changes --- physics/GFS_surface_generic.F90 | 7 ++++--- physics/GFS_surface_generic.meta | 9 +++++++++ physics/sfc_drv.meta | 2 +- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index e303b010f..4d41d7f62 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -30,7 +30,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & lndp_var_list, lndp_prt_list, & - z01d, zt1d, bexp1d, xlai1d, vegf1d, & + z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) @@ -68,6 +68,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: bexp1d real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d + real(kind=kind_phys), intent(out) :: lndp_vgf logical, intent(in) :: cplflx real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl @@ -90,7 +91,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Local variables integer :: i, k real(kind=kind_phys) :: onebg - real(kind=kind_phys) :: cdfz, lndp_vgf + real(kind=kind_phys) :: cdfz ! Set constants onebg = 1.0/con_g @@ -125,7 +126,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, call cdfnor(sfc_wts(i,k),cdfz) vegf1d(i) = cdfz enddo - lndp_vgf = Model%lndp_prt_list(k) + lndp_vgf = lndp_prt_list(k) end select enddo endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index cb90b0c8b..b716ac0f4 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -319,6 +319,15 @@ kind = kind_phys intent = out optional = F +[lndp_vgf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 0505c23ae..7db9221bb 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -435,7 +435,7 @@ kind = kind_phys intent = in optional = F -[lndp_vgf] +[pertvegf] standard_name = magnitude_of_perturbation_of_vegetation_fraction long_name = magnitude of perturbation of vegetation fraction units = frac From 78b9a67324b2a561caeabce1bf059d4a1fe19498 Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Thu, 16 Apr 2020 22:13:33 +0000 Subject: [PATCH 08/97] minor bug fix --- physics/GFS_surface_generic.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 4d41d7f62..3b18b261d 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -62,7 +62,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, intent(in) :: n_var_lndp character(len=3), dimension(n_var_lndp), intent(in) :: lndp_var_list real(kind=kind_phys), dimension(n_var_lndp), intent(in) :: lndp_prt_list - real(kind=kind_phys), dimension(im,nsfcpert), intent(in) :: sfc_wts + real(kind=kind_phys), dimension(im,n_var_lndp), intent(in) :: sfc_wts real(kind=kind_phys), dimension(im), intent(out) :: z01d real(kind=kind_phys), dimension(im), intent(out) :: zt1d real(kind=kind_phys), dimension(im), intent(out) :: bexp1d From f1c24fbd54d66fa78bb776d3770cd97b5dd2ba89 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 20 Apr 2020 23:34:01 +0000 Subject: [PATCH 09/97] after merging with NCAR/ccpp-physics/master and some bug fixes in some physics routines --- physics/GFS_MP_generic.F90 | 121 ++++--- physics/GFS_PBL_generic.F90 | 9 +- physics/GFS_suite_interstitial.F90 | 6 +- physics/GFS_surface_composites.F90 | 81 ++--- physics/GFS_surface_composites.meta | 9 + physics/GFS_surface_generic.F90 | 14 +- physics/GFS_surface_loop_control.F90 | 4 +- physics/gcm_shoc.F90 | 64 ++-- physics/m_micro.F90 | 518 +++++++++++++-------------- physics/micro_mg_utils.F90 | 60 ++-- physics/moninshoc.f | 104 +++--- physics/rascnv.F90 | 392 ++++++++++---------- physics/sfc_cice.f | 8 +- physics/sfc_diff.f | 188 +++++----- physics/sfc_drv.f | 86 ++--- physics/sfc_ocean.F | 42 +-- physics/sfc_ocean.meta | 18 - physics/sfc_sice.f | 23 +- 18 files changed, 874 insertions(+), 873 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index ab68e206a..bcf11db66 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -97,8 +97,8 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm real(kind=kind_phys), intent(in) :: dtf, frain, con_g - real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc - real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel + real(kind=kind_phys), dimension(im), intent(in) :: rain1, xlat, xlon, tsfc + real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel, rainc real(kind=kind_phys), dimension(im), intent(in) :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(ix,nrcm), intent(in) :: rann real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, prsl, save_t, save_qv, del @@ -149,7 +149,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt integer :: i, k, ic real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 - real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip + real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2 real(kind=kind_phys), dimension(im) :: domr, domzr, domip, doms, t850, work1 ! Initialize CCPP error handling variables @@ -157,7 +157,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt errflg = 0 onebg = one/con_g - + do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo @@ -171,7 +171,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! physics timestep, while Diag%{rain,rainc} and all totprecip etc ! are on the dynamics timestep. Confusing, but works if frain=1. *DH if (imp_physics == imp_physics_gfdl) then - tprcp = max(0., rain) ! clu: rain -> tprcp + tprcp = max(zero, rain) ! clu: rain -> tprcp !graupel = frain*graupel0 !ice = frain*ice0 !snow = frain*snow0 @@ -180,13 +180,13 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt snow = snow0 ! Do it right from the beginning for Thompson else if (imp_physics == imp_physics_thompson) then - tprcp = max (0.,rainc + frain * rain1) ! time-step convective and explicit precip + tprcp = max (zero, rainc + frain * rain1) ! time-step convective and explicit precip graupel = frain*graupel0 ! time-step graupel ice = frain*ice0 ! time-step ice snow = frain*snow0 ! time-step snow else if (imp_physics == imp_physics_fer_hires) then - tprcp = max (0.,rain) ! time-step convective and explicit precip + tprcp = max (zero, rain) ! time-step convective and explicit precip ice = frain*rain1*sr ! time-step ice end if @@ -200,7 +200,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt !Note (GJF): Precipitation LWE thicknesses are multiplied by the frain factor, and are thus on the dynamics time step, but the conversion as written ! (with dtp in the denominator) assumes the rate is calculated on the physics time step. This only works as expected when dtf=dtp (i.e. when frain=1). if (lsm == lsm_noahmp) then - tem = 1.0 / (dtp*con_p001) !GJF: This conversion was taken from GFS_physics_driver.F90, but should denominator also have the frain factor? + tem = one / (dtp*con_p001) !GJF: This conversion was taken from GFS_physics_driver.F90, but should denominator also have the frain factor? draincprv(:) = tem * raincprv(:) drainncprv(:) = tem * rainncprv(:) dsnowprv(:) = tem * snowprv(:) @@ -221,11 +221,11 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson) then do i=1,im - tprcp(i) = max(0.0, rain(i) ) - if(doms(i) > 0.0 .or. domip(i) > 0.0) then - srflag(i) = 1. + tprcp(i) = max(zero, rain(i) ) + if(doms(i) > zero .or. domip(i) > zero) then + srflag(i) = one else - srflag(i) = 0. + srflag(i) = zero end if enddo endif @@ -240,34 +240,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt endif - if (lssav) then -! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & -! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & -! 'rain=',Diag%rain(1) - do i=1,im - cnvprcp (i) = cnvprcp (i) + rainc(i) - totprcp (i) = totprcp (i) + rain(i) - totice (i) = totice (i) + ice(i) - totsnw (i) = totsnw (i) + snow(i) - totgrp (i) = totgrp (i) + graupel(i) - - cnvprcpb(i) = cnvprcpb(i) + rainc(i) - totprcpb(i) = totprcpb(i) + rain(i) - toticeb (i) = toticeb (i) + ice(i) - totsnwb (i) = totsnwb (i) + snow(i) - totgrpb (i) = totgrpb (i) + graupel(i) - enddo - - if (ldiag3d) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain - enddo - enddo - endif - endif - t850(1:im) = gt0(1:im,1) do k = 1, levs-1 @@ -294,12 +266,12 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (lsm /= lsm_ruc) then do i = 1, im !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 - srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) - if (tsfc(i) >= 273.15) then + srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) + if (tsfc(i) >= 273.15d0) then crain = rainc(i) - csnow = 0.0 + csnow = zero else - crain = 0.0 + crain = zero csnow = rainc(i) endif ! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then @@ -319,30 +291,65 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt endif ! lsm==lsm_ruc elseif( .not. cal_pre) then if (imp_physics == imp_physics_mg) then ! MG microphysics - tem = con_day / (dtp * con_p001) ! mm / day do i=1,im - tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp - if (rain(i)*tem > rainmin) then - srflag(i) = max(zero, min(one, (rain(i)-rainc(i))*sr(i)/rain(i))) + if (rain(i) > rainmin) then + tem1 = max(zero, (rain(i)-rainc(i))) * sr(i) + tem2 = one / rain(i) + if (t850(i) > 273.16d0) then + srflag(i) = max(zero, min(one, tem1*tem2)) + else + srflag(i) = max(zero, min(one, (tem1+rainc(i))*tem2)) + endif else - srflag(i) = 0.0 + srflag(i) = zero + rain(i) = zero + rainc(i) = zero endif + tprcp(i) = max(zero, rain(i) ) ! clu: rain -> tprcp enddo else do i = 1, im - tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp - srflag(i) = 0.0 ! clu: default srflag as 'rain' (i.e. 0) - if (t850(i) <= 273.16) then - srflag(i) = 1.0 ! clu: set srflag to 'snow' (i.e. 1) + tprcp(i) = max(zero, rain(i) ) ! clu: rain -> tprcp + srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) + if (t850(i) <= 273.16d0) then + srflag(i) = one ! clu: set srflag to 'snow' (i.e. 1) endif enddo endif endif + if (lssav) then +! if (Model%me == 0) print *,'in phys drive, kdt=',kdt, & +! 'totprcpb=', totprcpb(1),'totprcp=',totprcp(1), & +! 'rain=',rain(1) + do i=1,im + cnvprcp (i) = cnvprcp (i) + rainc(i) + totprcp (i) = totprcp (i) + rain(i) + totice (i) = totice (i) + ice(i) + totsnw (i) = totsnw (i) + snow(i) + totgrp (i) = totgrp (i) + graupel(i) + + cnvprcpb(i) = cnvprcpb(i) + rainc(i) + totprcpb(i) = totprcpb(i) + rain(i) + toticeb (i) = toticeb (i) + ice(i) + totsnwb (i) = totsnwb (i) + snow(i) + totgrpb (i) = totgrpb (i) + graupel(i) + enddo + + if (ldiag3d) then + do k=1,levs + do i=1,im + dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain +! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain + enddo + enddo + endif + endif + if (cplflx .or. cplchm) then do i = 1, im - drain_cpl(i) = rain(i) * (one-srflag(i)) - dsnow_cpl(i) = rain(i) * srflag(i) + dsnow_cpl(i)= max(zero, rain(i) * srflag(i)) + drain_cpl(i)= max(zero, rain(i) - dsnow_cpl(i)) rain_cpl(i) = rain_cpl(i) + drain_cpl(i) snow_cpl(i) = snow_cpl(i) + dsnow_cpl(i) enddo @@ -354,10 +361,10 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo endif - pwat(:) = 0.0 + pwat(:) = zero do k = 1, levs do i=1, im - work1(i) = 0.0 + work1(i) = zero enddo if (ncld > 0) then do ic = ntcw, ntcw+nncl-1 diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index ff59aa465..e8fed5ed8 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -335,8 +335,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), parameter :: one = 1.0d0 real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90 + real(kind=kind_phys), parameter :: qmin = 1.0d-8 integer :: i, k, kk, k1, n - real(kind=kind_phys) :: tem, tem1, rho + real(kind=kind_phys) :: tem, rho ! Initialize CCPP error handling variables errmsg = '' @@ -488,8 +489,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (cplchm) then do i = 1, im - tem1 = max(q1(i), 1.e-8) - tem = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) + tem = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin))) ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux enddo ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) @@ -508,8 +508,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dtsfci_cpl(i) = dtsfc_cice(i) dqsfci_cpl(i) = dqsfc_cice(i) elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - tem1 = max(q1(i), 1.e-8) - rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) + rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin))) if (wind(i) > zero) then tem = - rho * stress_ocn(i) / wind(i) dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 935dd9430..a8d5f5b8b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -201,7 +201,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl logical, dimension(im) :: invrsn real(kind=kind_phys), dimension(im) :: tx1, tx2 - real(kind=kind_phys), parameter :: qmin = 1.0d-10 + real(kind=kind_phys), parameter :: qmin = 1.0d-10, epsln=1.0d-10 ! Initialize CCPP error handling variables errmsg = '' @@ -246,13 +246,13 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl elseif (icy(i)) then ! ice (and water) tem = one - cice(i) if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + if (wet(i) .and. abs(adjsfculw_ocn(i)-huge) > epsln) then adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem else adjsfculw(i) = ulwsfc_cice(i) endif else - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + if (wet(i) .and. abs(adjsfculw_ocn(i)-huge) > epsln) then adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem else adjsfculw(i) = adjsfculw_ice(i) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 7cd552e69..c98650b99 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -39,7 +39,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl ! Interface variables integer, intent(in ) :: im logical, intent(in ) :: frac_grid, cplflx, cplwav2atm - logical, dimension(im), intent(in ) :: flag_cice + logical, dimension(im), intent(inout) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet real(kind=kind_phys), intent(in ) :: cimin real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, oceanfrac @@ -53,7 +53,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_ocn, weasd_lnd, weasd_ice, ep1d_ice, gflx_ice real(kind=kind_phys), dimension(im), intent( out) :: tice real(kind=kind_phys), intent(in ) :: tgice - integer, dimension(im), intent(in ) :: islmsk + integer, dimension(im), intent(inout) :: islmsk real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad real(kind=kind_phys), dimension(im), intent(inout) :: semis_ocn, semis_lnd, semis_ice real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice @@ -78,13 +78,16 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl if (cice(i) >= min_seaice) then icy(i) = .true. else - cice(i) = zero + cice(i) = zero + flag_cice(i) = .false. + islmsk = 0 endif else if (cice(i) >= min_lakeice) then icy(i) = .true. else cice(i) = zero + islmsk = 0 endif endif if (cice(i) < one ) then @@ -99,29 +102,35 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl else do i = 1, IM - frland(i) = zero - if (islmsk(i) == 0) then - ! tsfco(i) = Sfcprop%tsfc(i) - wet(i) = .true. - cice(i) = zero - elseif (islmsk(i) == 1) then - ! Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + if (islmsk(i) == 1) then +! tsfcl(i) = tsfc(i) dry(i) = .true. frland(i) = one cice(i) = zero - else - icy(i) = .true. + else + frland(i) = zero + if (flag_cice(i)) then + if (cice(i) > min_seaice) then + icy(i) = .true. + else + cice(i) = zero + flag_cice(i) = .false. + islmsk(i) = 0 + endif + else + if (cice(i) > min_lakeice) then + icy(i) = .true. + else + cice(i) = zero + islmsk(i) = 0 + endif + endif if (cice(i) < one) then - wet(i) = .true. - ! tsfco(i) = tgice - if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice) - ! if (.not. cplflx .or. lakefrac(i) > zero) tsfco(i) = max(tsfco(i), tisfc(i), tgice) - ! tsfco(i) = max((tsfc(i) - cice(i)*tisfc(i)) & - ! / (one - cice(i)), tgice) + wet(i)=.true. ! some open ocean/lake water exists + if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) endif endif enddo - endif if (.not. cplflx .or. .not. frac_grid) then @@ -293,7 +302,7 @@ subroutine GFS_surface_composites_post_run ( cmm, cmm_ocn, cmm_lnd, cmm_ice, chh, chh_ocn, chh_lnd, chh_ice, gflx, gflx_ocn, gflx_lnd, gflx_ice, ep1d, ep1d_ocn, & ep1d_lnd, ep1d_ice, weasd, weasd_ocn, weasd_lnd, weasd_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & tprcp_lnd, tprcp_ice, evap, evap_ocn, evap_lnd, evap_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, qss, qss_ocn, qss_lnd, & - qss_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, errmsg, errflg) + qss_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, min_seaice, errmsg, errflg) implicit none @@ -314,6 +323,7 @@ subroutine GFS_surface_composites_post_run ( real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature real(kind=kind_phys), dimension(im), intent(inout) :: hice, cice + real(kind=kind_phys), intent(in ) :: min_seaice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -452,23 +462,30 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_ocn(i) qss(i) = qss_ocn(i) tsfc(i) = tsfc_ocn(i) - !hice(i) = zero - !cice(i) = zero - !tisfc(i) = tsfc(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) else ! islmsk(i) == 2 zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) rb(i) = rb_ice(i) - stress(i) = cice(i)*stress_ice(i) + (one-cice(i))*stress_ocn(i) ffmm(i) = ffmm_ice(i) ffhh(i) = ffhh_ice(i) uustar(i) = uustar_ice(i) fm10(i) = fm10_ice(i) fh2(i) = fh2_ice(i) + stress(i) = stress_ice(i) !tsurf(i) = tsurf_ice(i) if (.not. flag_cice(i)) then tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + elseif (wet(i) .and. cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) endif cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) @@ -487,22 +504,6 @@ subroutine GFS_surface_composites_post_run ( zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) - if (flag_cice(i) .and. wet(i)) then ! this was already done for lake ice in sfc_sice - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) - tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) - else - if (islmsk(i) == 2) then - tisfc(i) = tice(i) - else ! over open ocean or land (no ice fraction) - hice(i) = zero - cice(i) = zero - tisfc(i) = tsfc(i) - endif - endif - enddo endif ! if (frac_grid) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 832d9227e..82e5a4289 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1650,6 +1650,15 @@ kind = kind_phys intent = inout optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = ??? + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index ac366ae54..9cdf14d85 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -246,7 +246,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: albdf = 0.06d0 + real(kind=kind_phys), parameter :: albdf = 0.06d0 integer :: i real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl @@ -304,12 +304,12 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt ! if (Sfcprop%landfrac(i) < one) then ! Not 100% land if (wet(i)) then ! some open water ! --- compute open water albedo - xcosz_loc = max( 0.0, min( 1.0, xcosz(i) )) - ocalnirdf_cpl = 0.06 - ocalnirbm_cpl = max(albdf, 0.026/(xcosz_loc**1.7+0.065) & - & + 0.15 * (xcosz_loc-0.1) * (xcosz_loc-0.5) & - & * (xcosz_loc-1.0)) - ocalvisdf_cpl = 0.06 + xcosz_loc = max( zero, min( one, xcosz(i) )) + ocalnirdf_cpl = 0.06d0 + ocalnirbm_cpl = max(albdf, 0.026d0/(xcosz_loc**1.7d0+0.065d0) & + & + 0.15d0 * (xcosz_loc-0.1d0) * (xcosz_loc-0.5d0) & + & * (xcosz_loc-one)) + ocalvisdf_cpl = 0.06d0 ocalvisbm_cpl = ocalnirbm_cpl nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl) diff --git a/physics/GFS_surface_loop_control.F90 b/physics/GFS_surface_loop_control.F90 index c701c523e..c7f727d27 100644 --- a/physics/GFS_surface_loop_control.F90 +++ b/physics/GFS_surface_loop_control.F90 @@ -47,7 +47,7 @@ subroutine GFS_surface_loop_control_part1_run (im, iter, wind, flag_guess, errms errflg = 0 do i=1,im - if (iter == 1 .and. wind(i) < 2.0) then + if (iter == 1 .and. wind(i) < 2.0d0) then flag_guess(i) = .true. endif enddo @@ -110,7 +110,7 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & flag_iter(i) = .false. flag_guess(i) = .false. - if (iter == 1 .and. wind(i) < 2.0) then + if (iter == 1 .and. wind(i) < 2.0d0) then !if (dry(i) .or. (wet(i) .and. .not.icy(i) .and. nstf_name1 > 0)) then if (dry(i) .or. (wet(i) .and. nstf_name1 > 0)) then flag_iter(i) = .true. diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index b32843bc1..9baa61516 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -46,7 +46,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: epsq = 1.d-20 + real(kind=kind_phys), parameter :: epsq = 1.0d-20, zero=0.0d0, one=1.0d0 integer :: i, k @@ -69,15 +69,15 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, do i=1,nx qc(i,k) = gq0(i,k,ntcw) if (abs(qc(i,k)) < epsq) then - qc(i,k) = 0.0 + qc(i,k) = zero endif - tem = qc(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) + tem = qc(i,k) * max(zero, MIN(one, (tcr-gt0(i,k))*tcrf)) qi(i,k) = tem ! ice qc(i,k) = qc(i,k) - tem ! water - qrn(i,k) = 0.0 - qsnw(i,k) = 0.0 - ncpl(i,k) = 0 - ncpi(i,k) = 0 + qrn(i,k) = zero + qsnw(i,k) = zero + ncpl(i,k) = zero + ncpi(i,k) = zero enddo enddo else @@ -617,7 +617,7 @@ subroutine tke_shoc() call eddy_length() ! Find turbulent mixing length call check_eddy() ! Make sure it's reasonable - tkef2 = 1.0 - tkef1 + tkef2 = one - tkef1 do k=1,nzm ku = k+1 kd = k @@ -661,7 +661,7 @@ subroutine tke_shoc() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001d0) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) @@ -849,7 +849,7 @@ subroutine eddy_length() ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,k) / (wrk+1.e-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.0d-20) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp @@ -993,7 +993,7 @@ subroutine eddy_length() enddo conv_var = conv_var ** oneb3 - if (conv_var > 0) then ! If convective vertical velocity scale > 0 + if (conv_var > zero) then ! If convective vertical velocity scale > 0 depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) @@ -1053,7 +1053,7 @@ subroutine conv_scale() !********************************************************************** conv_vel2(i,k) = conv_vel2(i,k-1) & - + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) + + 2.5d0*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1084,7 +1084,7 @@ subroutine check_eddy() do i=1,nx - wrk = 0.1*adzl(i,k) + wrk = 0.1d0*adzl(i,k) ! Minimum 0.1 of local dz smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) @@ -1092,7 +1092,7 @@ subroutine check_eddy() ! be not larger that that. ! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,kb) == 0 .and. qcl(i,k) > 0 .and. brunt(i,k) > 1.0d-4) then + if (qcl(i,kb) == zero .and. qcl(i,k) > zero .and. brunt(i,k) > 1.0d-4) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz smixt(i,k) = wrk endif @@ -1211,7 +1211,7 @@ subroutine canuto() omega0 = a4 / (one-a5*buoy_sgs2) omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5./4.)*omega0*f4 + omega2 = omega1*f3+(5.0d0/4.0d0)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) @@ -1234,7 +1234,7 @@ subroutine canuto() !aab ! Implemetation of the C01 approach in this subroutine is nearly complete @@ -1362,21 +1362,21 @@ subroutine assumed_pdf() ELSE !aab Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi ! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4 - w2_2 = 0.4 + w2_1 = 0.4d0 + w2_2 = 0.4d0 ! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0d0*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) onema = one - aterm sqrtw2t = sqrt(wrk) @@ -1450,12 +1450,12 @@ subroutine assumed_pdf() ! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4) THEN + IF (tsign > 0.4d0) THEN Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2) THEN + ELSEIF (tsign <= 0.2d0) THEN Skew_qw = zero ELSE - Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) + Skew_qw = (skew_facw/0.2d0) * Skew_w * (tsign-0.2d0) ENDIF wrk1 = qw1_1 * qw1_1 @@ -1489,7 +1489,7 @@ subroutine assumed_pdf() testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 - IF (testvar == 0) THEN + IF (testvar == zero) THEN r_qwthl_1 = zero ELSE r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & @@ -1648,8 +1648,7 @@ subroutine assumed_pdf() diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) - diag_qi = diag_qn - diag_ql - + diag_qi = max(zero, diag_qn - diag_ql) ! Update temperature variable based on diagnosed cloud properties om1 = max(zero, min(one, (tabs(i,k)-tbgmin)*a_bg)) @@ -1658,16 +1657,9 @@ subroutine assumed_pdf() + fac_sub *(diag_qi+qpi(i,k)) & + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating -! Update moisture fields - ! Update ncpl and ncpi Anning Cheng 03/11/2016 ! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) - qc(i,k) = diag_ql - qi(i,k) = diag_qi - qwv(i,k) = total_water(i,k) - diag_qn - cld_sgs(i,k) = diag_frac - ! Update ncpl and ncpi Moorthi 12/12/2018 if (ntlnc > 0) then ! liquid and ice number concentrations predicted if (ncpl(i,k) > nmin) then @@ -1682,6 +1674,12 @@ subroutine assumed_pdf() endif endif +! Update moisture fields + qc(i,k) = diag_ql + qi(i,k) = diag_qi + qwv(i,k) = max(zero, total_water(i,k) - diag_qn) + cld_sgs(i,k) = diag_frac + ! Compute the liquid water flux wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 83ff8d554..521070af7 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -19,12 +19,12 @@ module m_micro !> \section arg_table_m_micro_init Argument Table !! \htmlinclude m_micro_init.html !! -subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair, & +subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair,& eps, tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & - mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & - mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & - do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & - mg_nicons, mg_ngcons, mg_ncnst, mg_ninst, mg_ngnst, & + mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & + mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & + do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & + mg_nicons, mg_ngcons, mg_ncnst, mg_ninst, mg_ngnst, & mg_do_ice_gmao, mg_do_liq_liu, errmsg, errflg) use machine, only: kind_phys @@ -175,16 +175,16 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !------------------------------------ ! input ! real, parameter :: r_air = 3.47d-3 - real, parameter :: one=1.0, oneb3=one/3.0, onebcp=one/cp, & - & kapa=rgas*onebcp, cpbg=cp/grav, & - & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp,& - & qsmall=1.e-14, rainmin = 1.0e-13, & - & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 + real, parameter :: one=1.0d0, oneb3=one/3.0d0, onebcp=one/cp, & + zero=0.0d0, half=0.5d0, onebg=one/grav, & + & kapa=rgas*onebcp, cpbg=cp/grav, & + & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & + & qsmall=1.0d-14, rainmin = 1.0d-13, & + & fourb3=4.0d0/3.0d0, RL_cub=1.0d-15, nmin=1.0d0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag, iccn logical,intent(in) :: flipv, skip_macro - integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & @@ -353,27 +353,28 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & sflx, gflx ! real (kind=kind_phys), parameter :: disp_liu=2., ui_scale=1.0 & -! &, dcrit=20.0e-6 & - real (kind=kind_phys), parameter :: disp_liu=1.0, ui_scale=1.0 & - &, dcrit=1.0e-6 & +! &, dcrit=20.0d-6 & + real (kind=kind_phys), parameter :: disp_liu=1.0d0 & + &, ui_scale=1.0d0 & + &, dcrit=1.0d-6 & ! &, ts_autice=1800.0 & ! &, ts_autice=3600.0 & !time scale - &, ninstr8 = 0.1e6 & - &, ncnstr8 = 100.0e6 + &, ninstr8 = 0.1d6 & + &, ncnstr8 = 100.0d6 real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_r8 real(kind=kind_phys):: t_ice_denom - integer, dimension(1) :: lev_sed_strt ! sedimentation start level - real(kind=kind_phys), parameter :: sig_sed_strt=0.05 ! normalized pressure at sedimentation start + integer, dimension(1) :: lev_sed_strt ! sedimentation start level + real(kind=kind_phys), parameter :: sig_sed_strt=0.05d0 ! normalized pressure at sedimentation start real(kind=kind_phys),dimension(3) :: ccn_diag real(kind=kind_phys),dimension(58) :: cloudparams integer, parameter :: CCN_PARAM=2, IN_PARAM=5 - real(kind=kind_phys), parameter ::fdust_drop=1.0, fsoot_drop=0.1 & - &, sigma_nuc_r8=0.28,SCLMFDFR=0.03 + real(kind=kind_phys), parameter ::fdust_drop=1.0d0, fsoot_drop=0.1d0 & + &, sigma_nuc_r8=0.28d0,SCLMFDFR=0.03d0 ! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1 type (AerProps), dimension (IM,LM) :: AeroProps @@ -438,9 +439,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_UPDF(i,k) = cf_upi(i,ll) CNV_DQLDT(I,K) = CNV_DQLDT_i(I,ll) CLCN(I,k) = CLCN_i(I,ll) - CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),0.0) - PLO(i,k) = prsl_i(i,ll)*0.01 - zlo(i,k) = phil(i,ll) * (1.0/grav) + CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) + PLO(i,k) = prsl_i(i,ll)*0.01d0 + zlo(i,k) = phil(i,ll) * onebg temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) rhc(i,k) = rhc_i(i,ll) @@ -454,8 +455,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) *.01 ! interface pressure in hPa - zet(i,k+1) = phii(i,ll) * (1.0/grav) + PLE(i,k) = prsi_i(i,ll) * 0.01d0 ! interface pressure in hPa + zet(i,k+1) = phii(i,ll) * onebg END DO END DO if (.not. skip_macro) then @@ -483,7 +484,6 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & omega(i,k) = omega_i(i,k) ncpl(i,k) = ncpl_io(i,k) ncpi(i,k) = ncpi_io(i,k) - ncpi(i,k) = ncpi_io(i,k) rnw(i,k) = rnw_io(i,k) snw(i,k) = snw_io(i,k) qgl(i,k) = qgl_io(i,k) @@ -499,9 +499,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_UPDF(i,k) = cf_upi(i,k) CNV_DQLDT(I,K) = CNV_DQLDT_i(I,k) CLCN(I,k) = CLCN_i(I,k) - CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),0.0) - PLO(i,k) = prsl_i(i,k)*0.01 - zlo(i,k) = phil(i,k) * (1.0/grav) + CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) + PLO(i,k) = prsl_i(i,k)*0.01d0 + zlo(i,k) = phil(i,k) * onebg temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) rhc(i,k) = rhc_i(i,k) @@ -514,8 +514,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO DO K=0, LM DO I = 1,IM - PLE(i,k) = prsi_i(i,k) *.01 ! interface pressure in hPa - zet(i,k+1) = phii(i,k) * (1.0/grav) + PLE(i,k) = prsi_i(i,k) * 0.01d0 ! interface pressure in hPa + zet(i,k+1) = phii(i,k) * onebg END DO END DO if (.not. skip_macro) then @@ -551,19 +551,19 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) if (rnw(i,k) <= qc_min(1)) then - ncpr(i,k) = 0.0 + ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncps(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo @@ -577,8 +577,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I=1, IM DO K = LM-2, 10, -1 - If ((CNV_DQLDT(I,K) <= 1.0e-9) .and. & - & (CNV_DQLDT(I,K+1) > 1.0e-9)) then + If ((CNV_DQLDT(I,K) <= 1.0d-9) .and. & + & (CNV_DQLDT(I,K+1) > 1.0d-9)) then KCT(I) = K+1 exit end if @@ -657,8 +657,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=lm-1,1,-1 do i=1,im - tx1 = 0.5 * (temp(i,l+1) + temp(i,l)) - kh(i,l) = 3.55e-7*tx1**2.5*(rgas*0.01) / ple(i,l) !kh molecule diff only needing refinement + tx1 = half * (temp(i,l+1) + temp(i,l)) + kh(i,l) = 3.55d-7*tx1**2.5d0*(rgas*0.01d0) / ple(i,l) !kh molecule diff only needing refinement enddo end do do i=1,im @@ -667,38 +667,38 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo do L=LM,1,-1 do i=1,im - blk_l(i,l) = 1.0 / ( 1.0/max(0.15*ZPBL(i),0.4*zlo(i,lm-1))& - & + 1.0/(zlo(i,l)*.4) ) - - SC_ICE(i,l) = 1.0 - NCPL(i,l) = MAX( NCPL(i,l), 0.) - NCPI(i,l) = MAX( NCPI(i,l), 0.) - RAD_CF(i,l) = max(0.0, min(CLLS(i,l)+CLCN(i,l), 1.0)) - if (iccn .ne. 1) then - CDNC_NUC(i,l) = 0.0 - INC_NUC(i,l) = 0.0 + blk_l(i,l) = one / ( one/max(0.15d0*ZPBL(i),0.4d0*zlo(i,lm-1))& + & + one/(zlo(i,l)*0.4d0) ) + + SC_ICE(i,l) = one + NCPL(i,l) = MAX( NCPL(i,l), zero) + NCPI(i,l) = MAX( NCPI(i,l), zero) + RAD_CF(i,l) = max(zero, min(CLLS(i,l)+CLCN(i,l), one)) + if (iccn /= 1) then + CDNC_NUC(i,l) = zero + INC_NUC(i,l) = zero endif enddo end do ! T_ICE_ALL = TICE - 40.0 T_ICE_ALL = CLOUDPARAMS(33) + TICE - t_ice_denom = 1.0 / (tice - t_ice_all) + t_ice_denom = one / (tice - t_ice_all) do l=1,lm - rhdfdar8(l) = 1.e-8 - rhu00r8(l) = 0.95 + rhdfdar8(l) = 1.d-8 + rhu00r8(l) = 0.95d0 - ttendr8(l) = 0. - qtendr8(l) = 0. - cwtendr8(l) = 0. + ttendr8(l) = zero + qtendr8(l) = zero + cwtendr8(l) = zero - npccninr8(l) = 0. + npccninr8(l) = zero enddo do k=1,10 do l=1,lm - rndstr8(l,k) = 2.0e-7 + rndstr8(l,k) = 2.0d-7 enddo enddo @@ -730,18 +730,18 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! allocate(AERMASSMIX(IM,LM,15)) - if (iccn == 2) then + if ( iccn == 2) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else - AERMASSMIX(:,:,1:5) = 1.e-6 - AERMASSMIX(:,:,6:15) = 2.e-14 + AERMASSMIX(:,:,1:5) = 1.0d-6 + AERMASSMIX(:,:,6:15) = 2.0d-14 end if !> - Call aerconversion1() call AerConversion1 (AERMASSMIX, AeroProps) deallocate(AERMASSMIX) use_average_v = .false. - if (USE_AV_V > 0.0) then + if (USE_AV_V > zero) then use_average_v = .true. end if @@ -752,58 +752,58 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kcldtopcvn = KCT(I) - tausurf_gw = min(0.5*SQRT(TAUOROX(I)*TAUOROX(I) & - & + TAUOROY(I)*TAUOROY(I)), 10.0) + tausurf_gw = min(half*SQRT(TAUOROX(I)*TAUOROX(I) & + & + TAUOROY(I)*TAUOROY(I)), 10.0d0) do k=1,lm - uwind_gw(k) = min(0.5*SQRT( U1(I,k)*U1(I,k) & - & + V1(I,k)*V1(I,k)), 50.0) + uwind_gw(k) = min(half*SQRT( U1(I,k)*U1(I,k) & + & + V1(I,k)*V1(I,k)), 50.0d0) ! tausurf_gw =tausurf_gw + max (tausurf_gw, min(0.5*SQRT(TAUX(I , J)**2+TAUY(I , J)**2), 10.0)*BKGTAU) !adds a minimum value from unresolved sources - pm_gw(k) = 100.0*PLO(I,k) + pm_gw(k) = 100.0d0*PLO(I,k) tm_gw(k) = TEMP(I,k) - nm_gw(k) = 0.0 + nm_gw(k) = zero rho_gw(k) = pm_gw(k) /(RGAS*tm_gw(k)) ter8(k) = TEMP(I,k) - plevr8(k) = 100.*PLO(I,k) + plevr8(k) = 100.0d0*PLO(I,k) ndropr8(k) = NCPL(I,k) qir8(k) = QILS(I,k) + QICN(I,k) qcr8(k) = QLLS(I,k) + QLCN(I,k) qcaux(k) = qcr8(k) - npccninr8(k) = 0.0 - naair8(k) = 0.0 + npccninr8(k) = zero + naair8(k) = zero - npre8(k) = 0.0 + npre8(k) = zero - if (RAD_CF(I,k) > 0.01 .and. qir8(k) > 0.0) then + if (RAD_CF(I,k) > 0.01d0 .and. qir8(k) > zero) then npre8(k) = NPRE_FRAC*NCPI(I,k) else - npre8(k) = 0.0 + npre8(k) = zero endif omegr8(k) = OMEGA(I,k) - lc_turb(k) = max(blk_l(I,k), 50.0) + lc_turb(k) = max(blk_l(I,k), 50.0d0) ! rad_cooling(k) = RADheat(I,k) - if (npre8(k) > 0.0 .and. qir8(k) > 0.0) then - dpre8(k) = ( qir8(k)/(6.0*npre8(k)*900.0*PI))**(1.0/3.0) + if (npre8(k) > zero .and. qir8(k) > zero) then + dpre8(k) = ( qir8(k)/(6.0d0*npre8(k)*900.0d0*PI))**(one/3.0d0) else - dpre8(k) = 1.0e-9 + dpre8(k) = 1.0d-9 endif wparc_ls(k) = -omegr8(k) / (rho_gw(k)*GRAV) & & + cpbg * radheat(i,k) ! & + cpbg * rad_cooling(k) enddo do k=0,lm - pi_gw(k) = 100.0*PLE(I,k) - rhoi_gw(k) = 0.0 - ni_gw(k) = 0.0 - ti_gw(k) = 0.0 + pi_gw(k) = 100.0d0*PLE(I,k) + rhoi_gw(k) = zero + ni_gw(k) = zero + ti_gw(k) = zero enddo @@ -816,37 +816,37 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & ti_gw, nm_gw, q1(i,:)) do k=1,lm - nm_gw(k) = max(nm_gw(k), 0.005) + nm_gw(k) = max(nm_gw(k), 0.005d0) h_gw(k) = k_gw*rho_gw(k)*uwind_gw(k)*nm_gw(k) - if (h_gw(K) > 0.0) then - h_gw(K) = sqrt(2.0*tausurf_gw/h_gw(K)) + if (h_gw(K) > zero) then + h_gw(K) = sqrt(2.0d0*tausurf_gw/h_gw(K)) end if - wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133 + wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133d0 - wparc_cgw(k) = 0.0 + wparc_cgw(k) = zero end do !> - Subgrid variability from convective sources according to Barahona et al. 2014 (in preparation) if (kcldtopcvn > 20) then - ksa1 = 1.0 + ksa1 = one Nct = nm_gw(kcldtopcvn) - Wct = max(CNV_CVW(I,kcldtopcvn), 0.0) + Wct = max(CNV_CVW(I,kcldtopcvn), zero) fcn = maxval(CNV_UPDF(I,kcldtopcvn:LM)) do k=1,kcldtopcvn c2_gw = (nm_gw(k) + Nct) / Nct - wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56* & - & 1.806*c2_gw*c2_gw)*Wct*0.133 + wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56d0* & + & 1.806d0*c2_gw*c2_gw)*Wct*0.133d0 enddo end if do k=1,lm - dummyW(k) = 0.133*k_gw*uwind_gw(k)/nm_gw(k) + dummyW(k) = 0.133d0*k_gw*uwind_gw(k)/nm_gw(k) enddo do K=1, LM-5, 1 @@ -856,8 +856,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & end do do l=1,min(k,lm-5) - wparc_cgw(l) = 0.0 - wparc_gw(l) = 0.0 + wparc_cgw(l) = zero + wparc_gw(l) = zero enddo @@ -866,25 +866,25 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kbmin = min(kbmin, LM-1) - 4 do K = 1, LM wparc_turb(k) = KH(I,k) / lc_turb(k) - dummyW(k) = 10.0 + dummyW(k) = 10.0d0 enddo - if (FRLAND(I) < 0.1 .and. ZPBL(I) < 800.0 .and. & - & TEMP(I,LM) < 298.0 .and. TEMP(I,LM) > 274.0 ) then + if (FRLAND(I) < 0.1d0 .and. ZPBL(I) < 800.0d0 .and. & + & TEMP(I,LM) < 298.0d0 .and. TEMP(I,LM) > 274.0d0 ) then do K = 1, LM - dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01,10.0),-10.0) - dummyW(k) = 1.0 / (1.0+exp(dummyW(k))) + dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01d0,10.0d0),-10.0d0) + dummyW(k) = one / (one+exp(dummyW(k))) enddo maxkh = max(maxval(KH(I,kbmin:LM-1)*nm_gw(kbmin:LM-1)/ & - & 0.17), 0.3) + & 0.17d0), 0.3d0) do K = 1, LM - wparc_turb(k) = (1.0-dummyW(k))*wparc_turb(k) & + wparc_turb(k) = (one-dummyW(k))*wparc_turb(k) & & + dummyW(k)*maxkh enddo end if - wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2) + wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2d0) @@ -902,11 +902,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do K = 1, LM - if (plevr8(K) > 70.0) then + if (plevr8(K) > 70.0d0) then - ccn_diag(1) = 0.001 - ccn_diag(2) = 0.004 - ccn_diag(3) = 0.01 + ccn_diag(1) = 0.001d0 + ccn_diag(2) = 0.004d0 + ccn_diag(3) = 0.01d0 if (K > 2 .and. K <= LM-2) then tauxr8 = (ter8(K-1) + ter8(K+1) + ter8(K)) * oneb3 @@ -921,8 +921,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! call init_Aer(AeroAux_b) ! endif - pfrz_inc_r8(k) = 0.0 - rh1_r8 = 0.0 !related to cnv_dql_dt, needed to changed soon + pfrz_inc_r8(k) = zero + rh1_r8 = zero !related to cnv_dql_dt, needed to changed soon ! if (lprnt) write(0,*)' bef aero npccninr8=',npccninr8(k),' k=',k & ! &,' ccn_param=',ccn_param,' in_param=',in_param & @@ -943,7 +943,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! & size(ccn_diag), lprnt) ! if (lprnt) write(0,*)' aft aero npccninr8=',npccninr8(k),' k=',k - if (npccninr8(k) < 1.0e-12) npccninr8(k) = 0.0 + if (npccninr8(k) < 1.0d-12) npccninr8(k) = zero ! CCN01(I,K) = max(ccn_diag(1)*1e-6, 0.0) ! CCN04(I,K) = max(ccn_diag(2)*1e-6, 0.0) @@ -952,63 +952,63 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & else - ccn_diag(:) = 0.0 - smaxliq(K) = 0.0 - swparc(K) = 0.0 - smaxicer8(K) = 0.0 - nheticer8(K) = 0.0 - sc_icer8(K) = 2.0 -! sc_icer8(K) = 1.0 - naair8(K) = 0.0 - npccninr8(K) = 0.0 - nlimicer8(K) = 0.0 - nhet_immr8(K) = 0.0 - dnhet_immr8(K) = 0.0 - nhet_depr8(K) = 0.0 - nhet_dhfr8(K) = 0.0 - dust_immr8(K) = 0.0 - dust_depr8(K) = 0.0 - dust_dhfr8(K) = 0.0 + ccn_diag(:) = zero + smaxliq(K) = zero + swparc(K) = zero + smaxicer8(K) = zero + nheticer8(K) = zero + sc_icer8(K) = 2.0d0 +! sc_icer8(K) = 1.0d0 + naair8(K) = zero + npccninr8(K) = zero + nlimicer8(K) = zero + nhet_immr8(K) = zero + dnhet_immr8(K) = zero + nhet_depr8(K) = zero + nhet_dhfr8(K) = zero + dust_immr8(K) = zero + dust_depr8(K) = zero + dust_dhfr8(K) = zero end if ! SMAXL(I,k) = smaxliq(k) * 100.0 ! SMAXI(I,k) = smaxicer8(k) * 100.0 - NHET_NUC(I,k) = nheticer8(k) * 1e-6 - NLIM_NUC(I,k) = nlimicer8(k) * 1e-6 - SC_ICE(I,k) = min(max(sc_icer8(k),1.0),2.0) + NHET_NUC(I,k) = nheticer8(k) * 1.0d-6 + NLIM_NUC(I,k) = nlimicer8(k) * 1.0d-6 + SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0d0) ! SC_ICE(I,k) = min(max(sc_icer8(k),1.0),1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) ! if(temp(i,k) > T_ICE_ALL) SC_ICE(i,k) = 1.0 ! if(temp(i,k) > TICE) SC_ICE(i,k) = rhc(i,k) ! - if(iccn == 0) then + if (iccn == 0) then if(temp(i,k) < T_ICE_ALL) then ! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5d0) elseif(temp(i,k) > TICE) then SC_ICE(i,k) = rhc(i,k) else ! SC_ICE(i,k) = 1.0 ! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5) + tx1 = max(SC_ICE(I,k), 1.5d0) SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & - * t_ice_denom + * t_ice_denom endif endif - if (iccn .ne. 1) then + if (iccn /= 1) then CDNC_NUC(I,k) = npccninr8(k) INC_NUC (I,k) = naair8(k) endif - NHET_IMM(I,k) = max(nhet_immr8(k), 0.0) - DNHET_IMM(I,k) = max(dnhet_immr8(k), 0.0) - NHET_DEP(I,k) = nhet_depr8(k) * 1e-6 - NHET_DHF(I,k) = nhet_dhfr8(k) * 1e-6 - DUST_IMM(I,k) = max(dust_immr8(k), 0.0)*1e-6 - DUST_DEP(I,k) = max(dust_depr8(k), 0.0)*1e-6 - DUST_DHF(I,k) = max(dust_dhfr8(k), 0.0)*1e-6 - WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8 + NHET_IMM(I,k) = max(nhet_immr8(k), zero) + DNHET_IMM(I,k) = max(dnhet_immr8(k), zero) + NHET_DEP(I,k) = nhet_depr8(k) * 1.0d-6 + NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0d-6 + DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0d-6 + DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0d-6 + DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0d-6 + WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8d0 SIGW_GW (I,k) = wparc_gw(k) * wparc_gw(k) SIGW_CNV (I,k) = wparc_cgw(k) * wparc_cgw(k) SIGW_TURB (I,k) = wparc_turb(k) * wparc_turb(k) @@ -1121,24 +1121,24 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do k=1,lm do i=1,im - if (CNV_MFD(i,k) > 1.0e-6) then - tx1 = 1.0 / CNV_MFD(i,k) + if (CNV_MFD(i,k) > 1.0d-6) then + tx1 = one / CNV_MFD(i,k) CNV_NDROP(i,k) = CNV_NDROP(i,k) * tx1 CNV_NICE(i,k) = CNV_NICE(i,k) * tx1 else - CNV_NDROP(i,k) = 0.0 - CNV_NICE(i,k) = 0.0 + CNV_NDROP(i,k) = zero + CNV_NICE(i,k) = zero endif ! temp(i,k) = th1(i,k) * PK(i,k) - RAD_CF(i,k) = min(CLLS(i,k)+CLCN(i,k), 1.0) + RAD_CF(i,k) = min(CLLS(i,k)+CLCN(i,k), one) ! - if (iccn .ne. 1) then - if (PFRZ(i,k) > 0.0) then + if (iccn /= 1) then + if (PFRZ(i,k) > zero) then INC_NUC(i,k) = INC_NUC(i,k) * PFRZ(i,k) NHET_NUC(i,k) = NHET_NUC(i,k) * PFRZ(i,k) else - INC_NUC(i,k) = 0.0 - NHET_NUC(i,k) = 0.0 + INC_NUC(i,k) = zero + NHET_NUC(i,k) = zero endif endif @@ -1195,21 +1195,21 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & QL_TOT(i,k) = QLCN(i,k) + QLLS(i,k) QI_TOT(i,k) = QICN(i,k) + QILS(i,k) ! Anning if negative, borrow water and ice from vapor 11/23/2016 - if (QL_TOT(i,k) < 0.0) then + if (QL_TOT(i,k) < zero) then Q1(i,k) = Q1(i,k) + QL_TOT(i,k) TEMP(i,k) = TEMP(i,k) - lvbcp*QL_TOT(i,k) - QL_TOT(i,k) = 0.0 + QL_TOT(i,k) = zero endif - if (QI_TOT(i,k) < 0.0) then + if (QI_TOT(i,k) < zero) then Q1(i,k) = Q1(i,k) + QI_TOT(i,k) TEMP(i,k) = TEMP(i,k) - lsbcp*QI_TOT(i,k) - QI_TOT(i,k) = 0.0 + QI_TOT(i,k) = zero endif QTOT = QL_TOT(i,k) + QI_TOT(i,k) - if (QTOT > 0.0) then - FQA(i,k) = min(max(QCNTOT / QTOT, 0.0), 1.0) + if (QTOT > zero) then + FQA(i,k) = min(max(QCNTOT / QTOT, zero), one) else - FQA(i,k) = 0.0 + FQA(i,k) = zero endif enddo enddo @@ -1222,35 +1222,35 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !! Gettelman (2008) microphysics \cite Morrison_2008 do I=1,IM - LS_SNR(i) = 0.0 - LS_PRC2(i) = 0.0 + LS_SNR(i) = zero + LS_PRC2(i) = zero nbincontactdust = 1 do l=1,10 do k=1,lm - naconr8(k,l) = 0.0 - rndstr8(k,l) = 2.0e-7 + naconr8(k,l) = zero + rndstr8(k,l) = 2.0d-7 enddo enddo do k=1,lm - npccninr8(k) = 0.0 - naair8(k) = 0.0 - omegr8(k) = 0.0 + npccninr8(k) = zero + naair8(k) = zero + omegr8(k) = zero ! tx1 = MIN(CLLS(I,k) + CLCN(I,k), 0.99) - tx1 = MIN(CLLS(I,k) + CLCN(I,k), 1.00) - if (tx1 > 0.0) then - cldfr8(k) = min(max(tx1, 0.00001), 1.0) + tx1 = MIN(CLLS(I,k) + CLCN(I,k), one) + if (tx1 > zero) then + cldfr8(k) = min(max(tx1, 0.00001d0), one) else - cldfr8(k) = 0.0 + cldfr8(k) = zero endif if (temp(i,k) > tice) then liqcldfr8(k) = cldfr8(k) - icecldfr8(k) = 0.0 + icecldfr8(k) = zero elseif (temp(i,k) <= t_ice_all) then - liqcldfr8(k) = 0.0 + liqcldfr8(k) = zero icecldfr8(k) = cldfr8(k) else icecldfr8(k) = cldfr8(k) * (tice - temp(i,k))/(tice-t_ice_all) @@ -1264,23 +1264,23 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & qcr8(k) = QL_TOT(I,k) qir8(k) = QI_TOT(I,k) - ncr8(k) = MAX(NCPL(I,k), 0.0) - nir8(k) = MAX(NCPI(I,k), 0.0) + ncr8(k) = MAX(NCPL(I,k), zero) + nir8(k) = MAX(NCPI(I,k), zero) qrr8(k) = rnw(I,k) qsr8(k) = snw(I,k) qgr8(k) = qgl(I,k) - nrr8(k) = MAX(NCPR(I,k), 0.0) - nsr8(k) = MAX(NCPS(I,k), 0.0) - ngr8(k) = MAX(ncgl(I,k), 0.0) + nrr8(k) = MAX(NCPR(I,k), zero) + nsr8(k) = MAX(NCPS(I,k), zero) + ngr8(k) = MAX(ncgl(I,k), zero) naair8(k) = INC_NUC(I,k) npccninr8(k) = CDNC_NUC(I,k) - if (cldfr8(k) >= 0.001) then + if (cldfr8(k) >= 0.001d0) then nimmr8(k) = min(DNHET_IMM(I,k),ncr8(k)/(cldfr8(k)*DT_MOIST)) else - nimmr8(k) = 0.0 + nimmr8(k) = zero endif @@ -1296,7 +1296,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & nbincontactdust = naux endif naconr8(K, 1:naux) = AeroAux_b%num(1:naux) - rndstr8(K, 1:naux) = AeroAux_b%dpg(1:naux) * 0.5 + rndstr8(K, 1:naux) = AeroAux_b%dpg(1:naux) * half ! The following moved inside of if(fprcp <= 0) then loop ! Get black carbon properties for contact ice nucleation @@ -1305,11 +1305,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! naux = AeroAux_b%nmods ! rnsootr8 (K) = sum(AeroAux_b%dpg(1:naux))/naux - pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0 - rpdelr8(k) = 1. / pdelr8(k) - plevr8(k) = 100. * PLO(I,k) + pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0d0 + rpdelr8(k) = one / pdelr8(k) + plevr8(k) = 100.0d0 * PLO(I,k) zmr8(k) = ZLO(I,k) - ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.e-10) + ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0d-10) omegr8(k) = WSUB(I,k) ! alphar8(k) = max(alpht_x(i,k)/maxval(alpht_x(i,:))*8.,0.5) ! alphar8(k) = qcvar2 @@ -1317,12 +1317,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO do k=1,lm+1 - pintr8(k) = PLE(I,k-1) * 100.0 + pintr8(k) = PLE(I,k-1) * 100.0d0 kkvhr8(k) = KH(I,k-1) END DO lev_sed_strt = 0 - tx1 = 1.0 / pintr8(lm+1) + tx1 = one / pintr8(lm+1) do k=1,lm if (plevr8(k)*tx1 < sig_sed_strt) then lev_sed_strt(1) = k @@ -1402,8 +1402,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if (lprint) write(0,*)' prectr8=',prectr8(1), & ! & ' precir8=',precir8(1) - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm @@ -1414,17 +1414,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! &,' qvlatr8=',qvlatr8(k) TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_R8*onebcp - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_R8, 0.0) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_R8, zero) rnw(I,k) = qrr8(k) snw(I,k) = qsr8(k) NCPR(I,k) = nrr8(k) NCPS(I,k) = nsr8(k) - CLDREFFL(I,k) = min(max(effcr8(k), 10.), 150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.), 150.) - CLDREFFR(I,k) = max(droutr8(k)*0.5*1.e6, 150.) - CLDREFFS(I,k) = max(0.192*dsoutr8(k)*0.5*1.e6, 250.) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0), 150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0), 150.0d0) + CLDREFFR(I,k) = max(droutr8(k)*0.5d0*1.0d6, 150.0d0) + CLDREFFS(I,k) = max(0.192d0*dsoutr8(k)*0.5d0*1.0d6, 250.0d0) enddo ! K loop @@ -1506,8 +1506,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1516,15 +1516,15 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & rnw(I,k) = rnw(I,k) + qrtend(k)*dt_r8 snw(I,k) = snw(I,k) + qstend(k)*dt_r8 - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, 0.0) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, 0.0) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, 0.0) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.),150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.),150.) - CLDREFFR(I,k) = max(reff_rain(k),150.) - CLDREFFS(I,k) = max(reff_snow(k),250.) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) + CLDREFFR(I,k) = max(reff_rain(k),150.0d0) + CLDREFFS(I,k) = max(reff_snow(k),250.0d0) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1532,13 +1532,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! write(0,*)' aft micro_mg_tend LS_PRC2= ', LS_PRC2(i),' ls_snr=',ls_snr(i) ! endif else - LS_PRC2(I) = 0. - LS_SNR(I) = 0. + LS_PRC2(I) = zero + LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10. - CLDREFFI(I,k) = 50. - CLDREFFR(I,k) = 1000. - CLDREFFS(I,k) = 250. + CLDREFFL(I,k) = 10.0d0 + CLDREFFI(I,k) = 50.0d0 + CLDREFFR(I,k) = 1000.0d0 + CLDREFFS(I,k) = 250.0d0 enddo ! K loop endif ! @@ -1643,8 +1643,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1654,17 +1654,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & snw(I,k) = snw(I,k) + qstend(k)*dt_r8 qgl(I,k) = qgl(I,k) + qgtend(k)*dt_r8 - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, 0.0) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, 0.0) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, 0.0) - NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, 0.0) - - CLDREFFL(I,k) = min(max(effcr8(k), 10.),150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.),150.) - CLDREFFR(I,k) = max(reff_rain(k),150.) - CLDREFFS(I,k) = max(reff_snow(k),250.) - CLDREFFG(I,k) = max(reff_grau(k),250.) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) + NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, zero) + + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) + CLDREFFR(I,k) = max(reff_rain(k),150.0d0) + CLDREFFS(I,k) = max(reff_snow(k),250.0d0) + CLDREFFG(I,k) = max(reff_grau(k),250.0d0) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1672,14 +1672,14 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! write(0,*)' aft micro_mg_tend LS_PRC2= ', LS_PRC2(i),' ls_snr=',ls_snr(i) ! endif else - LS_PRC2(I) = 0. - LS_SNR(I) = 0. + LS_PRC2(I) = zero + LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10. - CLDREFFI(I,k) = 50. - CLDREFFR(I,k) = 1000. - CLDREFFS(I,k) = 250. - CLDREFFG(I,k) = 250. + CLDREFFL(I,k) = 10.0d0 + CLDREFFI(I,k) = 50.0d0 + CLDREFFR(I,k) = 1000.0d0 + CLDREFFS(I,k) = 250.0d0 + CLDREFFG(I,k) = 250.0d0 enddo ! K loop endif endif @@ -1705,19 +1705,19 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) QI_TOT(I,K) = QILS(I,K) + QICN(I,K) if (rnw(i,k) <= qc_min(1)) then - ncpl(i,k) = 0.0 - elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = zero + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo enddo @@ -1745,19 +1745,19 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & QI_TOT(I,K) = QILS(I,K) + QICN(I,K) ! if (rnw(i,k) <= qc_min(1)) then - ncpl(i,k) = 0.0 - elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = zero + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo enddo @@ -1771,8 +1771,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do K= 1, LM do I=1,IM - if (QI_TOT(i,k) <= 0.0) NCPI(i,k) = 0.0 - if (QL_TOT(i,k) <= 0.0) NCPL(i,k) = 0.0 + if (QI_TOT(i,k) <= zero) NCPI(i,k) = zero + if (QL_TOT(i,k) <= zero) NCPL(i,k) = zero end do end do @@ -1804,7 +1804,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO K=1, LM ll = lm-k+1 DO I = 1,IM - CLLS_io(i,k) = max(0.0, min(CLLS(i,ll)+CLCN(i,ll),1.0)) + CLLS_io(i,k) = max(zero, min(CLLS(i,ll)+CLCN(i,ll),one)) enddo enddo else @@ -1835,7 +1835,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (skip_macro) then DO K=1, LM DO I = 1,IM - CLLS_io(i,k) = max(0.0, min(CLLS(i,k)+CLCN(i,k),1.0)) + CLLS_io(i,k) = max(zero, min(CLLS(i,k)+CLCN(i,k),one)) enddo enddo else @@ -1849,12 +1849,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) - rn_o(i) = tx1 * dt_i * 0.001 + rn_o(i) = tx1 * dt_i * 0.001d0 if (rn_o(i) < rainmin) then - sr_o(i) = 0. + sr_o(i) = zero else - sr_o(i) = LS_SNR(i) / tx1 + sr_o(i) = max(zero, min(one, LS_SNR(i)/tx1)) endif ENDDO @@ -1925,7 +1925,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & real(kind=kind_phys), intent(out) :: nm(pcols,pver) real(kind=kind_phys), parameter :: r=rgas, cpair=cp, g=grav, & - oneocp=1.0/cp, n2min=1.e-8 + oneocp=1.0d0/cp, n2min=1.0d-8 !---------------------------Local storage------------------------------- integer :: ix,kx @@ -1941,15 +1941,15 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = 0 do ix = 1, ncol ti(ix,kx) = t(ix,kx+1) - rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0+fv*sph(ix,kx+1)))) + rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0d0+fv*sph(ix,kx+1)))) ni(ix,kx) = sqrt (g*g / (cpair*ti(ix,kx))) end do ! Interior points use centered differences do kx = 1, pver-1 do ix = 1, ncol - ti(ix,kx) = 0.5 * (t(ix,kx) + t(ix,kx+1)) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0+0.5*fv*(sph(ix,kx)+sph(ix,kx+1)))) + ti(ix,kx) = 0.5d0 * (t(ix,kx) + t(ix,kx+1)) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+0.5d0*fv*(sph(ix,kx)+sph(ix,kx+1)))) dtdp = (t(ix,kx+1)-t(ix,kx)) / (pm(ix,kx+1)-pm(ix,kx)) n2 = g*g/ti(ix,kx) * (oneocp - rhoi(ix,kx)*dtdp) ni(ix,kx) = sqrt (max (n2min, n2)) @@ -1961,7 +1961,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = pver do ix = 1, ncol ti(ix,kx) = t(ix,kx) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0+fv*sph(ix,kx))) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+fv*sph(ix,kx))) ni(ix,kx) = ni(ix,kx-1) end do @@ -1970,7 +1970,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & !----------------------------------------------------------------------------- do kx=1,pver do ix=1,ncol - nm(ix,kx) = 0.5 * (ni(ix,kx-1) + ni(ix,kx)) + nm(ix,kx) = 0.5d0 * (ni(ix,kx-1) + ni(ix,kx)) end do end do @@ -1993,7 +1993,7 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) ibot = pver-1 kcldtop = ibot+1 kuppest = 20 - cfcrit = 1e-2 + cfcrit = 1.0d-2 do k = kuppest , ibot diff --git a/physics/micro_mg_utils.F90 b/physics/micro_mg_utils.F90 index 89dd7193e..ec1843317 100644 --- a/physics/micro_mg_utils.F90 +++ b/physics/micro_mg_utils.F90 @@ -480,15 +480,15 @@ elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc if (liq_gmao) then pgam = 0.0005714_r8*1.e-6_r8*ncic*rho + 0.2714_r8 ! Anning modified lamc - if ((ncic > 1.0e-3) .and. (qcic > 1.0e-11)) then + if ((ncic > 1.0e-3_r8) .and. (qcic > 1.0e-11_r8)) then xs = 0.07_r8*(1000._r8*qcic/ncic) ** (-0.14_r8) else - xs = 1.2 + xs = 1.2_r8 end if xs = max(min(xs, 1.7_r8), 1.1_r8) xs = xs*xs*xs - xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.)/8.0_r8 + xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8 pgam = sqrt(xs) else @@ -549,15 +549,15 @@ subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) if (liq_gmao) then pgam(i) = 0.0005714_r8*1.e-6_r8*ncic(i)*rho(i) + 0.2714_r8 - if ((ncic(i) > 1.0e-3) .and. (qcic(i) > 1.0e-11)) then + if ((ncic(i) > 1.0e-3_r8) .and. (qcic(i) > 1.0e-11_r8)) then xs = 0.07_r8*(1000._r8*qcic(i)/ncic(i)) **(-0.14_r8) else - xs = 1.2 + xs = 1.2_r8 end if xs = max(min(xs, 1.7_r8), 1.1_r8) xs = xs*xs*xs - xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.)/8.0_r8 + xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8 pgam(i) = sqrt(xs) else pgam(i) = one - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic(i)*rho(i)) @@ -705,14 +705,14 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim) if (ice_sep) then miu_ice = max(min(0.008_r8*(lam*0.01)**0.87_r8, 10.0_r8), 0.1_r8) - tx1 = 1. + miu_ice - tx2 = 1. / gamma(tx1) - aux = (gamma(tx1+3.)*tx2) ** (1./3.) + tx1 = 1.0_r8 + miu_ice + tx2 = 1.0_r8 / gamma(tx1) + aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8) lam = lam*aux else - aux = 1. - tx1 = 1.0 - tx2 = 1.0 + aux = 1.0_r8 + tx1 = 1.0_r8 + tx2 = 1.0_r8 end if if (present(n0)) n0 = nic * lam**tx1*tx2 @@ -729,7 +729,7 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) end if else - lam = 0._r8 + lam = 0.0_r8 end if @@ -762,14 +762,14 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) lam(i) = (props%shape_coef * nic(i)/qic(i))**(1._r8/props%eff_dim) if (ice_sep) then miu_ice = max(min(0.008_r8*(lam(i)*0.01)**0.87_r8, 10.0_r8), 0.1_r8) - tx1 = 1. + miu_ice - tx2 = 1. / gamma(tx1) - aux = (gamma(tx1+3.)*tx2) ** (1./3.) + tx1 = 1.0_r8 + miu_ice + tx2 = 1.0_r8 / gamma(tx1) + aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8) lam(i) = lam(i)*aux else - aux = 1. - tx1 = 1.0 - tx2 = 1.0 + aux = 1.0_r8 + tx1 = 1.0_r8 + tx2 = 1.0_r8 end if if (present(n0)) n0(i) = nic(i) * lam(i)**tx1*tx2 @@ -786,7 +786,7 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) end if else - lam(i) = 0._r8 + lam(i) = 0.0_r8 end if enddo @@ -1094,12 +1094,12 @@ subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & beta6 = (one+three*xs)*(one+four*xs)*(one+five*xs) & / ((one+xs)*(one+xs+xs)) LW = 1.0e-3_r8 * qc(i) * rho(i) - NW = nc(i) * rho(i) * 1.e-6_r8 + NW = nc(i) * rho(i) * 1.e-6_r8 - xs = min(20.0, 1.03e16*(LW*LW)/(NW*SQRT(NW))) - au(i) = 1.1e10*beta6*LW*LW*LW & + xs = min(20.0_r8, 1.03e16_r8*(LW*LW)/(NW*SQRT(NW))) + au(i) = 1.1e10_r8*beta6*LW*LW*LW & * (one-exp(-(xs**miu_disp))) / NW - au(i) = au(i)*1.0e3/rho(i) + au(i) = au(i)*1.0e3_r8/rho(i) au(i) = au(i) * gamma(two+relvar(i)) & / (gamma(relvar(i))*(relvar(i)*relvar(i))) @@ -2149,7 +2149,7 @@ subroutine graupel_collecting_snow(qsic,qric,umr,ums,rho,lamr,n0r,lams,n0s, & tx5 = tx4 * tx4 * tx3 psacr(i) = cons31 * tx1 * rho(i) * n0r(i) * n0s(i) * tx5 & - * (5.0*tx4+tx3*(tx2+tx2+0.5*tx3)) + * (5.0_r8*tx4+tx3*(tx2+tx2+0.5_r8*tx3)) ! psacr(i) = cons31*(((1.2_r8*umr(i)-0.95_r8*ums(i))**2+ & ! 0.08_r8*ums(i)*umr(i))**0.5_r8*rho(i)* & @@ -2201,7 +2201,7 @@ subroutine graupel_collecting_cld_water(qgic,qcic,ncic,rho,n0g,lamg,bg,agn, & do i=1,mgncol - if (qgic(i) >= 1.e-8 .and. qcic(i) >= qsmall) then + if (qgic(i) >= 1.e-8_r8 .and. qcic(i) >= qsmall) then tx1 = cons*agn(i)*rho(i)*n0g(i) / lamg(i)**(bg+three) @@ -2346,8 +2346,8 @@ subroutine graupel_collecting_rain(qric,qgic,umg,umr,ung,unr,rho,n0r,lamr,n0g,la ! pracg is mixing ratio of rain per sec collected by graupel/hail tx1 = 1.2_r8*umr(i) - 0.95_r8*umg(i) tx1 = sqrt(tx1*tx1+0.08_r8*umg(i)*umr(i)) - tx2 = 1.0 / lamr(i) - tx3 = 1.0 / lamg(i) + tx2 = 1.0_r8 / lamr(i) + tx3 = 1.0_r8 / lamg(i) tx4 = tx2 * tx2 tx5 = tx4 * tx4 * tx3 tx6 = rho(i) * n0r(i) * n0g(i) @@ -2710,10 +2710,10 @@ FUNCTION gamma_incomp(muice, x) real(r8) :: gamma_incomp REAL(r8), intent(in) :: muice, x REAL(r8) :: xog, kg, alfa, auxx - alfa = min(max(muice+1., 1.), 20._r8) + alfa = min(max(muice+1._r8, 1._r8), 20._r8) xog = log(alfa -0.3068_r8) - kg = 1.44818*(alfa**0.5357_r8) + kg = 1.44818_r8*(alfa**0.5357_r8) auxx = max(min(kg*(log(x)-xog), 30._r8), -30._r8) gamma_incomp = max(one/(one+exp(-auxx)), 1.0e-20) diff --git a/physics/moninshoc.f b/physics/moninshoc.f index eb6ccd7e7..5bdf0ceef 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -91,20 +91,21 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, ttend, utend, vtend, qtend &, spdk2, rbint, ri, zol1, robn, bvf2 ! - real(kind=kind_phys), parameter :: zolcr=0.2, - & zolcru=-0.5, rimin=-100., sfcfrac=0.1, - & crbcon=0.25, crbmin=0.15, crbmax=0.35, - & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, - & aphi5=5., aphi16=16., f0=1.e-4 - &, dkmin=0.0, dkmax=1000. -! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 - &, prmin=0.25, prmax=4.0, vk=0.4, cfac=6.5 + real(kind=kind_phys), parameter :: one=1.0d0, zero=0.0d0 + &, zolcr=0.2d0, + & zolcru=-0.5d0, rimin=-100.0d0, sfcfrac=0.1d0, + & crbcon=0.25d0, crbmin=0.15d0, crbmax=0.35d0, + & qmin=1.0d-8, zfmin=1.0d-8, qlmin=1.0d-12, + & aphi5=5.0d0, aphi16=16.0d0, f0=1.0d-4 + &, dkmin=zero, dkmax=1000.0d0 +! &, dkmin=zero, dkmax=1000., xkzminv=0.3 + &, prmin=0.25d0, prmax=4.0d0, vk=0.4, cfac=6.5 real(kind=kind_phys) :: gravi, cont, conq, conw, gocp - gravi = 1.0/grav + gravi = one/grav cont = cp/grav conq = hvap/grav - conw = 1.0/grav + conw = one/grav gocp = grav/cp ! Initialize CCPP error handling variables @@ -122,7 +123,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, km1 = km - 1 kmpbl = km / 2 ! - rtg = 0.0 + rtg = zero ! do k=1,km do i=1,im @@ -137,24 +138,24 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,km1 do i=1,im - rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) - prnum(i,k) = 1.0 + rdzt(i,k) = one / (zl(i,k+1) - zl(i,k)) + prnum(i,k) = one enddo enddo ! Setup backgrond diffision do i=1,im - prnum(i,km) = 1.0 - tx1(i) = 1.0 / prsi(i,1) + prnum(i,km) = one + tx1(i) = one / prsi(i,1) enddo do k = 1,km1 do i=1,im - xkzo(i,k) = 0.0 - xkzmo(i,k) = 0.0 + xkzo(i,k) = zero + xkzmo(i,k) = zero ! if (k < kinver(i)) then if (k <= kinver(i)) then ! vertical background diffusivity for heat and momentum - tem1 = 1.0 - prsi(i,k+1) * tx1(i) - tem1 = min(1.0, exp(-tem1 * tem1 * 10.0)) + tem1 = one - prsi(i,k+1) * tx1(i) + tem1 = min(one, exp(-tem1 * tem1 * 10.0d0)) xkzo(i,k) = xkzm_h * tem1 xkzmo(i,k) = xkzm_m * tem1 endif @@ -165,9 +166,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,kmpbl do i=1,im - if(zi(i,k+1) > 250.) then + if(zi(i,k+1) > 250.0d0) then tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.e-5) then + if(tem1 > 1.0d-5) then xkzo(i,k) = min(xkzo(i,k),xkzminv) endif endif @@ -176,21 +177,21 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! do i = 1,im - z0(i) = 0.01 * zorl(i) + z0(i) = 0.01d0 * zorl(i) kpbl(i) = 1 hpbl(i) = zi(i,1) pblflg(i) = .true. sfcflg(i) = .true. - if(rbsoil(i) > 0.) sfcflg(i) = .false. - dusfc(i) = 0. - dvsfc(i) = 0. - dtsfc(i) = 0. - dqsfc(i) = 0. + if(rbsoil(i) > zero) sfcflg(i) = .false. + dusfc(i) = zero + dvsfc(i) = zero + dtsfc(i) = zero + dqsfc(i) = zero enddo ! do k = 1,km do i=1,im - tx1(i) = 0.0 + tx1(i) = zero enddo do kk=1,ncnd do i=1,im @@ -205,7 +206,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) - if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + if(.not.sfcflg(i) .or. sflux(i) <= zero) pblflg(i)=.false. beta(i) = dt2 / (zi(i,2)-zi(i,1)) enddo ! @@ -220,11 +221,12 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, thermal(i) = thvx(i,1) crb(i) = crbcon else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = max(1.0, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) + thermal(i) = tsea(i)*(one+fv*max(q1(i,1,1),qmin)) + tem = max(one, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = max(min(0.16 * (tem1 ** (-0.18)), crbmax), crbmin) + tem1 = 1.0d-7 * robn + crb(i) = max(min(0.16d0 * (tem1 ** (-0.18d0)), crbmax), + & crbmin) endif enddo do k = 1, kmpbl @@ -243,9 +245,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if(kpbl(i) > 1) then k = kpbl(i) if(rbdn(i) >= crb(i)) then - rbint = 0. + rbint = zero elseif(rbup(i) <= crb(i)) then - rbint = 1. + rbint = one else rbint = (crb(i)-rbdn(i)) / (rbup(i)-rbdn(i)) endif @@ -270,11 +272,11 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if(sfcflg(i)) then ! phim(i) = (1.-aphi16*zol1)**(-1./4.) ! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = 1.0 / max(1. - aphi16*zol1, 1.0e-8) + tem = one / max(one - aphi16*zol1, 1.0d-8) phih(i) = sqrt(tem) phim(i) = sqrt(phih(i)) else - phim(i) = 1. + aphi5*zol1 + phim(i) = one + aphi5*zol1 phih(i) = phim(i) endif enddo @@ -292,7 +294,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, do i = 1, im if(.not.flg(i)) then rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), 1.) + spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), one) rbup(i) = (thvx(i,k)-thermal(i)) * phil(i,k) & / (thvx(i,1)*spdk2) kpbl(i) = k @@ -304,9 +306,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (pblflg(i)) then k = kpbl(i) if(rbdn(i) >= crb(i)) then - rbint = 0. + rbint = zero elseif(rbup(i) <= crb(i)) then - rbint = 1. + rbint = one else rbint = (crb(i)-rbdn(i)) / (rbup(i)-rbdn(i)) endif @@ -344,19 +346,19 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, tem = u1(i,k) - u1(i,kp1) tem1 = v1(i,k) - v1(i,kp1) tem = (tem*tem + tem1*tem1) * rdz * rdz - bvf2 = (0.5*grav)*(thvx(i,kp1)-thvx(i,k))*rdz + bvf2 = (0.5d0*grav)*(thvx(i,kp1)-thvx(i,k))*rdz & / (t1(i,k)+t1(i,kp1)) ri = max(bvf2/tem,rimin) - if(ri < 0.) then ! unstable regime - prnum(i,kp1) = 1.0 + if(ri < zero) then ! unstable regime + prnum(i,kp1) = one else - prnum(i,kp1) = min(1.0 + 2.1*ri, prmax) + prnum(i,kp1) = min(one + 2.1d0*ri, prmax) endif elseif (k > 1) then prnum(i,kp1) = prnum(i,1) endif ! -! prnum(i,kp1) = 1.0 +! prnum(i,kp1) = one prnum(i,kp1) = max(prmin, min(prmax, prnum(i,kp1))) tem = tkh(i,kp1) * prnum(i,kp1) dku(i,k) = max(min(tem+xkzmo(i,k), dkmax), xkzmo(i,k)) @@ -367,7 +369,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for heat and moisture ! do i=1,im - ad(i,1) = 1. + ad(i,1) = one a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo @@ -399,7 +401,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k)-au(i,k) - ad(i,kp1) = 1.-al(i,k) + ad(i,kp1) = one - al(i,k) dsdzt = tem1 * gocp a1(i,k) = a1(i,k) + dtodsd*dsdzt a1(i,kp1) = t1(i,kp1) - dtodsu*dsdzt @@ -458,7 +460,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for momentum ! do i=1,im - ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + ad(i,1) = one + beta(i) * stress(i) / spd1(i) a1(i,1) = u1(i,1) a2(i,1) = v1(i,1) enddo @@ -476,7 +478,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k) - au(i,k) - ad(i,kp1) = 1.0 - al(i,k) + ad(i,kp1) = one - al(i,k) a1(i,kp1) = u1(i,kp1) a2(i,kp1) = v1(i,kp1) ! @@ -503,7 +505,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for tke ! do i=1,im - ad(i,1) = 1.0 + ad(i,1) = one a1(i,1) = q1(i,1,ntke) enddo ! @@ -520,7 +522,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k) - au(i,k) - ad(i,kp1) = 1.0 - al(i,k) + ad(i,kp1) = one - al(i,k) a1(i,kp1) = q1(i,kp1,ntke) enddo enddo diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 49d93e3fb..40d0ecb0d 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -13,34 +13,34 @@ module rascnv integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 - real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & + real (kind=kind_phys), parameter :: delt_c=1800.0d0/3600.0d0 & ! Adjustment time scales in hrs for deep and shallow clouds ! &, adjts_d=3.0, adjts_s=0.5 ! &, adjts_d=2.5, adjts_s=0.5 - &, adjts_d=2.0, adjts_s=0.5 + &, adjts_d=2.0d0, adjts_s=0.5d0 ! logical, parameter :: fix_ncld_hr=.true. ! - real (kind=kind_phys), parameter :: ZERO=0.0, HALF=0.5 & - &, pt25=0.25 & - &, ONE=1.0, TWO=2.0, FOUR=4.& - &, twoo3=two/3.0 & - &, FOUR_P2=4.E2, ONE_M10=1.E-10 & - &, ONE_M6=1.E-6, ONE_M5=1.E-5 & - &, ONE_M2=1.E-2, ONE_M1=1.E-1 & - &, oneolog10=one/log(10.0) & - &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) - &, cmb2pa = 100.0 ! Conversion from hPa to Pa -! - real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & - &, rhfacs=0.75, rhfacl=0.75 & - &, face=5.0, delx=10000.0 & - &, ddfac=face*delx*0.001 & - &, max_neg_bouy=0.15 & -! &, max_neg_bouy=pt25 & + real (kind=kind_phys), parameter :: ZERO=0.0d0, HALF=0.5d0 & + &, pt25=0.25d0, ONE=1.0d0 & + &, TWO=2.0d0, FOUR=4.0d0 & + &, twoo3=two/3.0d0 & + &, FOUR_P2=4.0d2, ONE_M10=1.0d-10& + &, ONE_M6=1.0d-6, ONE_M5=1.0d-5 & + &, ONE_M2=1.0d-2, ONE_M1=1.0d-1 & + &, oneolog10=one/log(10.0d0) & + &, facmb = 0.01d0 & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa = 100.0d0 ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: frac=0.5d0, crtmsf=0.0d0 & + &, rhfacs=0.75d0, rhfacl=0.75d0 & + &, face=5.0d0, delx=10000.0d0 & + &, ddfac=face*delx*0.001d0 & + &, max_neg_bouy=0.15d0 & +! &, max_neg_bouy=pt25d0 & &, testmb=0.1, testmbi=one/testmb & - &, dpd=0.5, rknob=1.0, eknob=1.0 + &, dpd=0.5d0, rknob=1.0d0, eknob=1.0d0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! logical, parameter :: do_aw=.true., cumfrc=.true. & @@ -52,17 +52,17 @@ module rascnv ! &, advcld=.true., advups=.false.,advtvd=.false. - real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & - &, TCRF=1.0/(TCR-TF), TCL=2.0 + real(kind=kind_phys), parameter :: TF=233.16d0, TCR=273.16d0 & + &, TCRF=one/(TCR-TF), TCL=2.0d0 ! ! For pressure gradient force in momentum mixing ! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & ! No pressure gradient force in momentum mixing - real (kind=kind_phys), parameter :: pgftop=0.0, pgfbot=0.0 & + real (kind=kind_phys), parameter :: pgftop=0.0d0, pgfbot=0.0d0 & ! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & - &, pgfgrad=(pgfbot-pgftop)*0.001 & - &, cfmax=0.1 + &, pgfgrad=(pgfbot-pgftop)*0.001d0& + &, cfmax=0.1d0 ! ! For Tilting Angle Specification ! @@ -167,7 +167,7 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & ! ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! - AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 + AFC = -(1.01097d-4*DT)*(3600.0d0/DT)**0.57777778d0 ! grav = con_g ; cp = con_cp ; alhl = con_hvap alhf = con_hfus ; rgas = con_rd @@ -182,12 +182,12 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & rkap = rgas * onebcp ; deg2rad = pi/180.d0 ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS - picon = half*pi*onebg ; zfac = 0.28888889E-4 * ONEBG + picon = half*pi*onebg ; zfac = 0.28888889d-4 * ONEBG testmboalhl = testmb/alhl ! - rvi = one/rv ; facw=CVAP-CLIQ - faci = CVAP-CSOL ; hsub=alhl+alhf - tmix = TTP-20.0 ; DEN=one/(TTP-TMIX) + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0d0 ; DEN=one/(TTP-TMIX) ! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & @@ -365,7 +365,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & integer, dimension(100) :: ic - real(kind=kind_phys), parameter :: clwmin=1.0e-10 + real(kind=kind_phys), parameter :: clwmin=1.0d-10 ! real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & &, trcfac(:,:), rcu(:,:) @@ -487,23 +487,23 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (flipv) ll = kp1 -l ! Input variables are bottom to top! SGC = prsl(ipt,ll) * tem sgcs(l,ipt) = sgc - IF (SGC <= 0.050) KRMIN = L -! IF (SGC <= 0.700) KRMAX = L -! IF (SGC <= 0.800) KRMAX = L - IF (SGC <= 0.760) KRMAX = L -! IF (SGC <= 0.930) KFMAX = L - IF (SGC <= 0.970) KFMAX = L ! Commented on 20060202 -! IF (SGC <= 0.700) kblmx = L ! Commented on 20101015 - IF (SGC <= 0.600) kblmx = L ! -! IF (SGC <= 0.650) kblmx = L ! Commented on 20060202 - IF (SGC <= 0.980) kblmn = L ! + IF (SGC <= 0.050d0) KRMIN = L +! IF (SGC <= 0.700d0) KRMAX = L +! IF (SGC <= 0.800d0) KRMAX = L + IF (SGC <= 0.760d0) KRMAX = L +! IF (SGC <= 0.930d0) KFMAX = L + IF (SGC <= 0.970d0) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700d0) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600d0) kblmx = L ! +! IF (SGC <= 0.650d0) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980d0) kblmn = L ! ENDDO krmin = max(krmin,2) ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 - NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001d0 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 @@ -513,7 +513,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & facdt = delt_c / dt else NCRND = min(nrcmax, (KRMAX-KRMIN+1)) - facdt = one / 3600.0 + facdt = one / 3600.0d0 endif NCRND = min(nrcm,max(NCRND, 1)) ! @@ -537,7 +537,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & IF (NCRND > 0) THEN DO I=1,NCRND II = mod(i-1,nrcm) + 1 - IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) + IRND = (RANNUM(ipt,II)-0.0005d0)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF @@ -582,7 +582,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,ll,n+2) - if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero enddo endif enddo @@ -593,7 +593,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & phi_h(LL) = phii(ipt,L) enddo ! - if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0) then ! input ice/water are together do l=1,k ll = kp1 -l tem = ccin(ipt,ll,1) & @@ -631,7 +631,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,l,n+2) - if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero enddo endif enddo @@ -641,7 +641,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & phi_h(L) = phii(ipt,L) ENDDO ! - if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0) then ! input ice/water are together do l=1,k tem = ccin(ipt,l,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) @@ -688,7 +688,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd=',dtvd(:,1) - if (abs(dtvd(2,1)) > 1.0e-10) then + if (abs(dtvd(2,1)) > 1.0d-10) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h @@ -702,7 +702,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) - if (abs(dtvd(2,2)) > 1.0e-10) then + if (abs(dtvd(2,2)) > 1.0d-10) then tem1 = dtvd(1,2) / dtvd(2,2) tem2 = abs(tem1) alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q @@ -713,7 +713,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) - if (abs(dtvd(2,3)) > 1.0e-10) then + if (abs(dtvd(2,3)) > 1.0d-10) then tem1 = dtvd(1,3) / dtvd(2,3) tem2 = abs(tem1) alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql @@ -724,7 +724,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) - if (abs(dtvd(2,4)) > 1.0e-10) then + if (abs(dtvd(2,4)) > 1.0d-10) then tem1 = dtvd(1,4) / dtvd(2,4) tem2 = abs(tem1) alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi @@ -741,7 +741,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l - if (abs(dtvd(2,1)) > 1.0e-10) then + if (abs(dtvd(2,1)) > 1.0d-10) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers @@ -850,7 +850,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & FLXD(L) = zero enddo ! - TLA = -10.0 + TLA = -10.0d0 ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection @@ -906,7 +906,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & - & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + & max(zero,(QLI(ib)+QII(ib)-qiid-qlid))/dt ! & max(0.,(QLI(ib)+QII(ib)))/dt/3. if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ib @@ -930,7 +930,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ENDDO ! End of the NC loop! ! - RAINC(ipt) = rain * 0.001 ! Output rain is in meters + RAINC(ipt) = rain * 0.001d0 ! Output rain is in meters ktop(ipt) = kp1 kbot(ipt) = 0 @@ -944,9 +944,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! clw(i) = max(clw(i), zero) ! cli(i) = max(cli(i), zero) - if (sgcs(l,ipt) < 0.93 .and. abs(tcu(l)) > one_m10) then -! if (sgcs(l,ipt) < 0.90 .and. tcu(l) .ne. 0.0) then -! if (sgcs(l,ipt) < 0.85 .and. tcu(l) .ne. 0.0) then + if (sgcs(l,ipt) < 0.93d0 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90d0 .and. tcu(l) .ne. 0.0) then +! if (sgcs(l,ipt) < 0.85d0 .and. tcu(l) .ne. 0.0) then kcnv(ipt) = 1 endif ! New test for convective clouds ! added in 08/21/96 @@ -972,18 +972,18 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) CNV_FICE(ipt,ll) = QICN(ipt,ll) & - & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) + & / max(1.d-10,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) QICN(ipt,ll) = qii(l) - CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) + CNV_FICE(ipt,ll) = qii(l)/max(1.d-10,qii(l)+qli(l)) endif - cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & - & 500*ud_mf(ipt,ll)/dt), cfmax)) + cf_upi(ipt,ll) = max(zero,min(0.02d0*log(one+ & + & 500.0d0*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) + & (dt*max(cf_upi(ipt,ll),1.d-12)*prsl(ipt,ll)) endif if (ntr > 0) then @@ -1023,21 +1023,21 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) CNV_FICE(ipt,l) = QICN(ipt,l) & - & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) + & / max(1.d-10,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) QICN(ipt,l) = qii(l) - CNV_FICE(ipt,l) = qii(l)/max(1.e-10,qii(l)+qli(l)) + CNV_FICE(ipt,l) = qii(l)/max(1.d-10,qii(l)+qli(l)) endif !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02*log(one+ & - & 500*ud_mf(ipt,l)/dt), cfmax)) + cf_upi(ipt,l) = max(zero,min(0.02d0*log(one+ & + & 500.d0*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) + & (dt*max(cf_upi(ipt,l),1.d-12)*prsl(ipt,l)) endif if (ntr > 0) then @@ -1140,33 +1140,33 @@ SUBROUTINE CLOUD( & ! IMPLICIT NONE ! - real (kind=kind_phys), parameter :: RHMAX=1.0 & ! MAX RELATIVE HUMIDITY - &, QUAD_LAM=1.0 & ! MASK FOR QUADRATIC LAMBDA - &, RHRAM=0.05 & ! PBL RELATIVE HUMIDITY RAMP -! &, RHRAM=0.15 !& ! PBL RELATIVE HUMIDITY RAMP - &, HCRITD=4000.0 & ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0 & ! Critical Moist Static Energy for Shallow clouds - &, pcrit_lcl=250.0 & ! Critical pressure difference between boundary layer top - ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01 !& ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005 !& ! Perturbation on hbl when ctei=.true. + real (kind=kind_phys), parameter :: RHMAX=1.0d0 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0d0 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05d0 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15d0 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0d0 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0d0 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0d0 & ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01d0 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005d0 !& ! Perturbation on hbl when ctei=.true. &, qudfac=quad_lam*half & - &, shalfac=3.0 & + &, shalfac=3.0d0 & ! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's - &, c0ifac=0.07 & ! following Han et al, 2016 MWR - &, dpnegcr = 150.0 -! &, dpnegcr = 100.0 -! &, dpnegcr = 200.0 -! - real(kind=kind_phys), parameter :: ERRMIN=0.0001 & - &, ERRMI2=0.1*ERRMIN & -! &, rainmin=1.0e-9 !& - &, rainmin=1.0e-8 & - &, oneopt9=1.0/0.09 & - &, oneopt4=1.0/0.04 - real(kind=kind_phys), parameter :: almax=1.0e-2 & - &, almin1=0.0, almin2=0.0 - real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 + &, c0ifac=0.07d0 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0d0 +! &, dpnegcr = 100.0d0 +! &, dpnegcr = 200.0d0 +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001d0 & + &, ERRMI2=0.1d0*ERRMIN & +! &, rainmin=1.0d-9 !& + &, rainmin=1.0d-8 & + &, oneopt9=1.0d0/0.09d0 & + &, oneopt4=1.0d0/0.04d0 + real(kind=kind_phys), parameter :: almax=1.0d-2 & + &, almin1=0.0d0, almin2=0.0d0 + real(kind=kind_phys), parameter :: bldmax=300.0d0, bldmin=25.0d0 ! ! INPUT ARGUMENTS @@ -1371,8 +1371,14 @@ SUBROUTINE CLOUD( & ! To determine KBL internally -- If KBL is defined externally ! the following two loop should be skipped ! - hcrit = hcritd - if (sgcs(kd) > 0.65) hcrit = hcrits + if (sgcs(kd) < 0.5d0) then + hcrit = hcritd + elseif (sgcs(kd) > 0.65d0) then + hcrit = hcrits + else + hcrit = (hcrits*(sgcs(kd)-0.5d0) + hcritd*(0.65d0-sgcs(kd)))& + & * (one/0.15d0) + endif IF (CALKBL) THEN KTEM = MAX(KD+1, KBLMX) hmin = hol(k) @@ -1455,7 +1461,7 @@ SUBROUTINE CLOUD( & ii = max(kbl,kd1) kbl = max(klcl,kd1) - tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) + tem = min(50.0d0,max(10.0d0,(prl(kmaxp1)-prl(kd))*0.10d0)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii @@ -1515,7 +1521,7 @@ SUBROUTINE CLOUD( & ! shal_fac = one ! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac - if (prl(kbl)-prl(kd) < 350.0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0d0 .and. kmax == k) shal_fac = shalfac DO L=Kmax,KD,-1 IF (L >= KBL) THEN ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM @@ -1577,7 +1583,7 @@ SUBROUTINE CLOUD( & endif enddo ! - if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0) & + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0d0) & & return ! TX1 = RHFACS - QBL / TX1 ! Average RH @@ -1587,9 +1593,9 @@ SUBROUTINE CLOUD( & IF (.NOT. cnvflg) RETURN ! - RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0d0*TX1) )) ! - wcbase = 0.1 + wcbase = 0.1d0 if (ntrc > 0) then DO N=1,NTRC RBL(N) = ROI(Kmax,N) * ETA(Kmax) @@ -1602,9 +1608,9 @@ SUBROUTINE CLOUD( & ! ! if (ntk > 0 .and. do_aw) then if (ntk > 0) then - if (rbl(ntk) > 0.0) then - wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) -! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + if (rbl(ntk) > zero) then + wcbase = min(two, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(one, max(wcbase, sqrt(twoo3*rbl(ntk)))) endif endif @@ -1665,7 +1671,7 @@ SUBROUTINE CLOUD( & QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE ! st1 = qil(kd) - st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) + st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1687,7 +1693,7 @@ SUBROUTINE CLOUD( & AKC(L) = one / AKT(L) ! st1 = half * (qil(l)+qil(lp1)) - st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,0.0)) + st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1746,13 +1752,13 @@ SUBROUTINE CLOUD( & HSU = HSU - ALM * TX3 ! CLP = ZERO - ALM = -100.0 + ALM = -100.0d0 HOS = HOL(KD) QOS = QOL(KD) QIS = CIL(KD) QLS = CLL(KD) - cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 + cnvflg = HBL > HSU .and. abs(tx1) > 1.0d-4 !*********************************************************************** @@ -1769,7 +1775,7 @@ SUBROUTINE CLOUD( & if (tx2 == zero) then alm = - st2 / tx1 - if (alm > almax) alm = -100.0 + if (alm > almax) alm = -100.0d0 else x00 = tx2 + tx2 epp = tx1 * tx1 - (x00+x00)*st2 @@ -1778,8 +1784,8 @@ SUBROUTINE CLOUD( & tem = sqrt(epp) tem1 = (-tx1-tem)*x00 tem2 = (-tx1+tem)*x00 - if (tem1 > almax) tem1 = -100.0 - if (tem2 > almax) tem2 = -100.0 + if (tem1 > almax) tem1 = -100.0d0 + if (tem2 > almax) tem2 = -100.0d0 alm = max(tem1,tem2) endif @@ -1850,12 +1856,12 @@ SUBROUTINE CLOUD( & ACR = zero TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF tx1 = PRL(KBL) - TEM - tx2 = min(900.0, max(tx1,100.0)) - tem1 = log(tx2*0.01) * oneolog10 + tx2 = min(900.0d0, max(tx1,100.0d0)) + tem1 = log(tx2*0.01d0) * oneolog10 tem2 = one - tem1 if ( kdt == 1 ) then -! rel_fac = (dt * facdt) / (tem1*12.0 + tem2*3.0) - rel_fac = (dt * facdt) / (tem1*6.0 + tem2*adjts_s) +! rel_fac = (dt * facdt) / (tem1*12.0d0 + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0d0 + tem2*adjts_s) else rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) endif @@ -1864,7 +1870,7 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - iwk = tem*0.02-0.999999999 + iwk = tem*0.02d0 - 0.999999999d0 iwk = MAX(1, MIN(iwk, 16)) ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF ENDIF @@ -2037,7 +2043,7 @@ SUBROUTINE CLOUD( & ! CALCUP = .FALSE. - TEM = max(0.05, MIN(CD*200.0, MAX_NEG_BOUY)) + TEM = max(0.05d0, MIN(CD*200.0d0, MAX_NEG_BOUY)) IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. @@ -2080,7 +2086,7 @@ SUBROUTINE CLOUD( & ENDIF PL = (PRL(KD1) + PRL(KD))*HALF - IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + IF (TRAIN > 1.0d-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) @@ -2395,7 +2401,7 @@ SUBROUTINE CLOUD( & ! sigf(kd) = max(zero, min(one, tx1 * tx1)) ! endif if (do_aw) then - tx1 = (0.2 / max(alm, 1.0e-5)) + tx1 = (0.2d0 / max(alm, 1.0d-5)) tx2 = one - min(one, pi * tx1 * tx1 / area) tx2 = tx2 * tx2 @@ -2519,8 +2525,8 @@ SUBROUTINE CLOUD( & endif enddo tem = tem + amb * dof * sigf(kbl) - tem = tem * (3600.0/dt) - tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 + tem = tem * (3600.0d0/dt) + tem1 = sqrt(max(one, min(100.0d0,(6.25d10/max(area,one))))) ! 20110530 clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) cldfrd = clfrac @@ -2567,7 +2573,7 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778d0 ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) @@ -2575,7 +2581,7 @@ SUBROUTINE CLOUD( & ! tem4 = zero if (tx2 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778d0 ) ) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2644,7 +2650,7 @@ SUBROUTINE CLOUD( & ! following Liu et al. [JGR,2001] Eq 1 if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001) + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001d0) FNOSCAV = exp(- FSCAV_(N) * DELZKM) else FNOSCAV = one @@ -2654,7 +2660,7 @@ SUBROUTINE CLOUD( & & * FNOSCAV DO L=KD1,K if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001) + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001d0) FNOSCAV = exp(- FSCAV_(N) * DELZKM) endif lm1 = l - 1 @@ -2773,7 +2779,7 @@ SUBROUTINE DDRFT( & &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & &, IDW, IDH, IDN(K), idnm, itr ! - parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) + parameter (ERRMIN=0.0001d0, ERRMI2=0.1d0*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! ! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi @@ -2783,8 +2789,9 @@ SUBROUTINE DDRFT( & ! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) ! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) ! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) - PARAMETER (AA1=1.0, BB1=1.0, CC1=1.0, DD1=1.0, F3=CC1, F5=1.0) - parameter (QRMIN=1.0E-6, WC2MIN=0.01, GMF1=GMF/AA1, GMF5=GMF/F5) + PARAMETER (AA1=1.0d0, BB1=1.0d0, CC1=1.0d0, DD1=1.0d0, & + & F3=CC1, F5=1.0d0) + parameter (QRMIN=1.0d-6, WC2MIN=0.01d0, GMF1=GMF/AA1, GMF5=GMF/F5) ! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) @@ -2793,11 +2800,12 @@ SUBROUTINE DDRFT( & &, itrmin=15, itrmnd=12, numtla=2 ! uncentering for vvel in dd - real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 & + real(kind=kind_phys), parameter :: ddunc1=0.25d0 & + &, ddunc2=one-ddunc1 & ! &, ddunc1=0.4, ddunc2=one-ddunc1 & ! &, ddunc1=0.3, ddunc2=one-ddunc1 & - &, VTPEXP=-0.3636 & - &, VTP=36.34*SQRT(1.2)*(0.001)**0.1364 + &, VTPEXP=-0.3636d0 & + &, VTP=36.34d0*SQRT(1.2d0)*(0.001d0)**0.1364d0 ! ! real(kind=kind_phys) EM(K*K), ELM(K) real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & @@ -2822,7 +2830,7 @@ SUBROUTINE DDRFT( & CLDFRD = zero RNTP = zero DOF = zero - ERRQ = 10.0 + ERRQ = 10.0d0 RNB = zero RNT = zero TX2 = PRL(KBL) @@ -2853,7 +2861,7 @@ SUBROUTINE DDRFT( & ENDDO if (kk /= kbl) then do l=kk,kbl - buy(l) = 0.9 * buy(l-1) + buy(l) = 0.9d0 * buy(l-1) enddo endif ! @@ -2861,24 +2869,24 @@ SUBROUTINE DDRFT( & qrpi(l) = buy(l) enddo do l=kd1,kb1 - buy(l) = 0.25 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + buy(l) = 0.25d0 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) enddo ! ! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) - tx1 = 1000.0 + tx1 - prl(kp1) + tx1 = 1000.0d0 + tx1 - prl(kp1) ! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) CALL ANGRAD(TX1, ALM, AL2, TLA) ! ! Following Ucla approach for rain profile ! - F2 = (BB1+BB1)*ONEBG/(PI*0.2) + F2 = (BB1+BB1)*ONEBG/(PI*0.2d0) ! WCMIN = SQRT(WC2MIN) ! WCBASE = WCMIN ! ! del_tla = TLA * 0.2 ! del_tla = TLA * 0.25 - del_tla = TLA * 0.3 + del_tla = TLA * 0.3d0 TLA = TLA - DEL_TLA ! DO L=KD,K @@ -2939,15 +2947,15 @@ SUBROUTINE DDRFT( & do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries ! ------ ! if (errq < 1.0 .or. tla > 45.0) cycle - if (errq < 0.1 .or. tla > 45.0) cycle + if (errq < 0.1d0 .or. tla > 45.0d0) cycle ! tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle ! - STLA = F2 * STLA * AL2 - CTL2 = DD1 * CTL2 - CTL3 = 0.1364 * CTL2 + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364d0 * CTL2 ! DO L=KD,K RNF(L) = zero @@ -3010,7 +3018,7 @@ SUBROUTINE DDRFT( & VRW(1) = F3*WVL(KD) - CTL2*VT(1) BUD(KD) = STLA * TX6 * QRB(KD) * half RNF(KD) = BUD(KD) - DOF = 1.1364 * BUD(KD) * QRPI(KD) + DOF = 1.1364d0 * BUD(KD) * QRPI(KD) DOFW = -BUD(KD) * STLT(KD) ! RNT = TRW(1) * VRW(1) @@ -3044,7 +3052,7 @@ SUBROUTINE DDRFT( & ! QA(2) = DOF WA(2) = DOFW - DOF = 1.1364 * BUD(L) * QRPI(L) + DOF = 1.1364d0 * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + QQQ * ST1 @@ -3115,7 +3123,7 @@ SUBROUTINE DDRFT( & QA(2) = DOF WA(2) = DOFW - DOF = 1.1364 * BUD(L) * QRPI(L) + DOF = 1.1364d0 * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + ST1 @@ -3250,7 +3258,7 @@ SUBROUTINE DDRFT( & ENDDO ! ! tem = 0.5 - if (tx2 > one .and. abs(errq-tx2) > 0.1) then + if (tx2 > one .and. abs(errq-tx2) > 0.1d0) then tem = half !! elseif (tx2 < 0.1) then !! tem = 1.2 @@ -3273,17 +3281,17 @@ SUBROUTINE DDRFT( & ENDIF ELSE TEM = ERRQ - TX2 -! IF (TEM < ZERO .AND. ERRQ > 0.1) THEN - IF (TEM < ZERO .AND. ERRQ > 0.5) THEN +! IF (TEM < ZERO .AND. ERRQ > 0.1d0) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5d0) THEN ! IF (TEM < ZERO .and. & -! & (ntla < numtla .or. ERRQ > 0.5)) THEN +! & (ntla < numtla .or. ERRQ > 0.5d0)) THEN SKPUP = .TRUE. ! No convergence ! - ERRQ = 10.0 ! No rain profile! + ERRQ = 10.0d0 ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! - elseif (tem < zero .and. errq < 0.1) then + elseif (tem < zero .and. errq < 0.1d0) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then errq = zero @@ -3301,7 +3309,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the ITR Loop!! ! - IF (ERRQ < 0.1) THEN + IF (ERRQ < 0.1d0) THEN DDFT = .TRUE. RNB = - RNB ! do l=kd1,kb1-1 @@ -3322,7 +3330,7 @@ SUBROUTINE DDRFT( & TX1 = TX1 + RNF(L) ENDDO TX1 = TRAIN / (TX1+RNT+RNB) - IF (ABS(TX1-one) < 0.2) THEN + IF (ABS(TX1-one) < 0.2d0) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 DO L=KD,KB1 @@ -3332,7 +3340,7 @@ SUBROUTINE DDRFT( & ELSE DDFT = .FALSE. - ERRQ = 10.0 + ERRQ = 10.0d0 ENDIF ENDIF ! @@ -3356,7 +3364,7 @@ SUBROUTINE DDRFT( & WCB(L) = zero ENDDO ! - ERRQ = 10.0 + ERRQ = 10.0d0 ! At this point stlt contains inverse of updraft vertical velocity 1/Wu. KK = MAX(KB1,KD1) @@ -3402,9 +3410,9 @@ SUBROUTINE DDRFT( & IF (RNT > zero) THEN if (TX1 > zero) THEN QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & - & ** (one/1.1364) + & ** (one/1.1364d0) else - tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364) + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364d0) endif RNTP = (one - RPART) * RNT BUY(KD) = - ROR(KD) * TX1 * QRP(KD) @@ -3465,7 +3473,7 @@ SUBROUTINE DDRFT( & VRW(1) = half * (GAM(L-1) + GAM(L)) VRW(2) = one / (VRW(1) + VRW(1)) ! - TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.00*EKNOB) + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0d0*EKNOB) ! DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! ! @@ -3473,7 +3481,7 @@ SUBROUTINE DDRFT( & HOD(L) = HOD(L-1) QOD(L) = QOD(L-1) ! - ERRQ = 10.0 + ERRQ = 10.0d0 ! IF (L <= KBL) THEN @@ -3498,7 +3506,7 @@ SUBROUTINE DDRFT( & IF (L == KD1) THEN IF (RNT > zero) THEN TEM = MAX(QRP(L-1),QRP(L)) - WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0d0) ENDIF WVL(L) = MAX(ONE_M2, WVL(L)) TRW(1) = TRW(1) * half @@ -3626,9 +3634,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 ! - CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) @@ -3639,7 +3647,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3660,7 +3668,7 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(TEM,ZERO) ELSEIF (TX5 > zero) THEN QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ELSE QRP(L) = zero ENDIF @@ -3687,7 +3695,7 @@ SUBROUTINE DDRFT( & ! WVL(L) = 0.5*tem1 ! WVL(L) = 0.1*tem1 ! WVL(L) = 0.0 - WVL(L) = 1.0e-10 + WVL(L) = 1.0d-10 else WVL(L) = half*(WVL(L)+TEM1) endif @@ -3701,7 +3709,7 @@ SUBROUTINE DDRFT( & ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2d0) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3713,7 +3721,7 @@ SUBROUTINE DDRFT( & TX5 = TX9 else TX5 = (STLT(KB1) * QRT(KB1) & - & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) + & + STLT(KBL) * QRB(KB1)) * (0.5d0*FAC) endif EVP(L-1) = zero @@ -3722,14 +3730,14 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ! endif BUY(L) = - ROR(L) * TX5 * QRP(L) WCB(L-1) = zero ENDIF ! DEL_ETA = ETD(L) - ETD(L-1) - IF(DEL_ETA < zero .AND. ERRQ > 0.1) THEN + IF(DEL_ETA < zero .AND. ERRQ > 0.1d0) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3756,9 +3764,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L-1) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 ! - CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) @@ -3769,7 +3777,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3822,7 +3830,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the iteration loop for a given L! IF (L <= K) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.1 .and. l <= kbl) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1d0 .and. l <= kbl) THEN !!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN ! & .AND. ERRQ > ERRMIN*10.0) THEN ROR(L) = BUD(KD) @@ -3845,7 +3853,7 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ! ENDIF ETD(L) = zero WVL(L) = zero @@ -3876,7 +3884,7 @@ SUBROUTINE DDRFT( & ! not converge) , no downdraft is assumed ! ! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & - IF (ERRQ > 0.1 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. + IF (ERRQ > 0.1d0 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. ! DOF = zero IF (.NOT. DDFT) RETURN @@ -3980,7 +3988,7 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys) es, d, hlorv, W ! ! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! + es = min(p, 0.01d0 * fpvs(tt)) ! fpvs is in Pascals! ! D = one / max(p+epsm1*es,ONE_M10) D = one / (p+epsm1*es) ! @@ -4001,7 +4009,7 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) ! integer i ! - IF (TLA < 0.0) THEN + IF (TLA < 0.0d0) THEN IF (PRES <= PLAC(1)) THEN TLA = TLAC(1) ELSEIF (PRES <= PLAC(2)) THEN @@ -4038,8 +4046,8 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) TEM = REFR(6) ENDIF ! - tem = 2.0E-4 / tem - al2 = min(4.0*tem, max(alm, tem)) + tem = 2.0d-4 / tem + al2 = min(4.0d0*tem, max(alm, tem)) ! RETURN end subroutine angrad @@ -4051,18 +4059,18 @@ SUBROUTINE SETQRP integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! XMIN = 1.0E-6 - XMIN = 0.0 - XMAX = 5.0 + XMIN = 0.0d0 + XMAX = 5.0d0 XINC = (XMAX-XMIN)/(NQRP-1) C2XQRP = one / XINC C1XQRP = one - XMIN*C2XQRP - TEM1 = 0.001 ** 0.2046 - TEM2 = 0.001 ** 0.525 + TEM1 = 0.001d0 ** 0.2046d0 + TEM2 = 0.001d0 ** 0.525d0 DO JX=1,NQRP X = XMIN + (JX-1)*XINC - TBQRP(JX) = X ** 0.1364 - TBQRA(JX) = TEM1 * X ** 0.2046 - TBQRB(JX) = TEM2 * X ** 0.525 + TBQRP(JX) = X ** 0.1364d0 + TBQRA(JX) = TEM1 * X ** 0.2046d0 + TBQRB(JX) = TEM2 * X ** 0.525d0 ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN @@ -4087,12 +4095,12 @@ end subroutine qrabf SUBROUTINE SETVTP implicit none - real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 + real(kind=kind_phys), parameter :: vtpexp=-0.3636d0, one=1.0d0 real(kind=kind_phys) xinc,x,xmax,xmin integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - XMIN = 0.05 - XMAX = 1.5 + XMIN = 0.05d0 + XMAX = 1.5d0 XINC = (XMAX-XMIN)/(NVTP-1) C2XVTP = one / XINC C1XVTP = one - XMIN*C2XVTP @@ -4139,10 +4147,10 @@ real(kind=kind_phys) FUNCTION CLF(PRATE) implicit none real(kind=kind_phys) PRATE ! - real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & - &, ccf3=0.04, ccf4=0.01 & - &, pr1=1.0, pr2=5.0 & - &, pr3=20.0 + real (kind=kind_phys), parameter :: ccf1=0.30d0, ccf2=0.09d0 & + &, ccf3=0.04d0, ccf4=0.01d0 & + &, pr1=1.0d0, pr2=5.0d0 & + &, pr3=20.0d0 ! if (prate < pr1) then clf = ccf1 diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index d0aaee476..9cb2b5f21 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -127,21 +127,21 @@ subroutine sfc_cice_run & ! if (.not. cplflx) return ! - cpinv = 1.0/cp - hvapi = 1.0/hvap + cpinv = 1.0d0/cp + hvapi = 1.0d0/hvap elocp = hvap/cp ! do i = 1, im if (flag_cice(i) .and. flag_iter(i)) then rho = prsl1(i) & - & / (rd * t1(i) * (1.0 + rvrdm1*max(q1(i), 1.0e-8))) + & / (rd * t1(i) * (1.0d0 + rvrdm1*max(q1(i), 1.0d-8))) cmm(i) = wind(i) * cm(i) chh(i) = wind(i) * ch(i) * rho qsurf(i) = q1(i) + dqsfc(i) / (hvap*chh(i)) - tem = 1.0 / rho + tem = 1.0d0 / rho hflx(i) = dtsfc(i) * tem * cpinv evap(i) = dqsfc(i) * tem * hvapi stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 60d5ceeea..f15e20d53 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -14,7 +14,7 @@ module sfc_diff private - real (kind=kind_phys), parameter :: ca=.4 ! ca - von karman constant + real (kind=kind_phys), parameter :: ca=0.4d0 ! ca - von karman constant contains @@ -128,9 +128,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys) :: tvs, z0, z0max, ztmax ! real(kind=kind_phys), parameter :: - & charnock=.014, z0s_max=.317e-2 &! a limiting value at high winds over sea - &, vis=1.4e-5, rnu=1.51e-5, visi=1.0/vis & - &, log01=log(0.01), log05=log(0.05), log07=log(0.07) + & one=1.0d0, zero=0.0d0, half=0.5d0, qmin=1.0d-8 + &, charnock=.014d0, z0s_max=.317d-2 &! a limiting value at high winds over sea + &, zmin=1.0d-6 & + &, vis=1.4d-5, rnu=1.51d-5, visi=one/vis & + &, log01=log(0.01d0), log05=log(0.05d0), log07=log(0.07d0) ! parameter (charnock=.014,ca=.4)!c ca is the von karman constant ! parameter (alpha=5.,a0=-3.975,a1=12.32,b1=-7.755,b2=6.041) @@ -161,7 +163,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) do i=1,im if(flag_iter(i)) then - virtfac = 1.0 + rvrdm1 * max(q1(i),1.e-8) + virtfac = one + rvrdm1 * max(q1(i),qmin) thv1 = t1(i) * prslki(i) * virtfac ! compute stability dependent exchange coefficients @@ -169,15 +171,16 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! if (dry(i)) then ! Some land #ifdef GSD_SURFACE_FLUXES_BUGFIX - tvs = 0.5 * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) * virtfac + tvs = half * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) + & * virtfac #else - tvs = 0.5 * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac + tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac #endif - z0max = max(1.0e-6, min(0.01 * z0rl_lnd(i), z1(i))) + z0max = max(zmin, min(0.01d0 * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land - tem1 = 1.0 - shdmax(i) + tem1 = one - shdmax(i) tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = one - tem2 if( ivegsrc == 1 ) then @@ -187,10 +190,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 7) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max = 0.01d0 elseif (vegtype(i) == 16) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max = 0.01d0 else z0max = exp( tem2*log01 + tem1*log(z0max) ) endif @@ -203,35 +206,35 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 9) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max = 0.01d0 elseif (vegtype(i) == 11) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max = 0.01d0 else z0max = exp( tem2*log01 + tem1*log(z0max) ) endif endif ! mg, sfc-perts: add surface perturbations to z0max over land - if (z0pert(i) /= 0.0 ) then - z0max = z0max * (10.**z0pert(i)) + if (z0pert(i) /= zero ) then + z0max = z0max * (10.0d0**z0pert(i)) endif - z0max = max(z0max, 1.0e-6) + z0max = max(z0max, zmin) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil - czilc = 0.8 + czilc = 0.8d0 - tem1 = 1.0 - sigmaf(i) + tem1 = one - sigmaf(i) ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) + & * czilc*ca*sqrt(ustar_lnd(i)*(0.01d0/1.5d-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land - if (ztpert(i) /= 0.0) then - ztmax = ztmax * (10.**ztpert(i)) + if (ztpert(i) /= zero) then + ztmax = ztmax * (10.0d0**ztpert(i)) endif - ztmax = max(ztmax, 1.0e-6) + ztmax = max(ztmax, zmin) ! call stability ! --- inputs: @@ -243,12 +246,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif ! Dry points if (icy(i)) then ! Some ice - tvs = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * virtfac - z0max = max(1.0e-6, min(0.01 * z0rl_ice(i), z1(i))) + tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac + z0max = max(zmin, min(0.01d0 * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice - tem1 = 1.0 - shdmax(i) + tem1 = one - shdmax(i) tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = one - tem2 if( ivegsrc == 1 ) then @@ -257,16 +260,16 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = exp( tem2*log01 + tem1*log(z0max) ) endif - z0max = max(z0max, 1.0e-6) + z0max = max(z0max, zmin) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height ! dependance of czil - czilc = 0.8 + czilc = 0.8d0 - tem1 = 1.0 - sigmaf(i) + tem1 = one - sigmaf(i) ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) - ztmax = max(ztmax, 1.0e-6) + & * czilc*ca*sqrt(ustar_ice(i)*(0.01d0/1.5d-05))) + ztmax = max(ztmax, zmin) ! call stability ! --- inputs: @@ -281,9 +284,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac - z0 = 0.01 * z0rl_ocn(i) - z0max = max(1.0e-6, min(z0,z1(i))) + tvs = half * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac + z0 = 0.01d0 * z0rl_ocn(i) + z0max = max(zmin, min(z0,z1(i))) ustar_ocn(i) = sqrt(grav * z0 / charnock) wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) @@ -291,7 +294,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ztmax = z0max - restar = max(ustar_ocn(i)*z0max*visi, 0.000001) + restar = max(ustar_ocn(i)*z0max*visi, 0.000001d0) ! restar = log(restar) ! restar = min(restar,5.) @@ -300,8 +303,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! rat = rat / (1. + (bb2 + cc2*restar) * restar)) ! rat taken from zeng, zhao and dickinson 1997 - rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) - ztmax = max(z0max * exp(-rat), 1.0e-6) + rat = min(7.0d0, 2.67d0 * sqrt(sqrt(restar)) - 2.57d0) + ztmax = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) @@ -335,19 +338,19 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! z0 = arnu / (ustar(i) * ff ** pp) if (redrag) then - z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) + z0rl_ocn(i) = 100.0d0 * max(min(z0, z0s_max), 1.d-7) else - z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_ocn(i) = 100.0d0 * max(min(z0,.1d0), 1.d-7) endif elseif (sfc_z0_type == 6) then ! wang call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm + z0rl_ocn(i) = 100.0d0 * z0 ! cm elseif (sfc_z0_type == 7) then ! wang call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm + z0rl_ocn(i) = 100.0d0 * z0 ! cm else - z0rl_ocn(i) = 1.0e-4 + z0rl_ocn(i) = 1.0d-4 endif endif @@ -378,11 +381,12 @@ subroutine stability & & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar ! --- locals: - real(kind=kind_phys), parameter :: alpha=5., a0=-3.975 & - &, a1=12.32, alpha4=4.0*alpha - &, b1=-7.755, b2=6.041, alpha2=alpha+alpha, beta=1.0 - &, a0p=-7.941, a1p=24.75, b1p=-8.705, b2p=7.899 - &, ztmin1=-999.0 + real(kind=kind_phys), parameter :: alpha=5.0d0, a0=-3.975d0 & + &, a1=12.32d0, alpha4=4.0d0*alpha & + &, b1=-7.755d0, b2=6.041d0, alpha2=alpha+alpha & + &, beta=1.0d0 & + &, a0p=-7.941d0, a1p=24.75d0, b1p=-8.705d0, b2p=7.899d0& + &, ztmin1=-999.0d0, zero=0.0d0, one=1.0d0 real(kind=kind_phys) aa, aa0, bb, bb0, dtv, adtv, & hl1, hl12, pm, ph, pm10, ph2, @@ -391,51 +395,51 @@ subroutine stability & & hl110, hlt, hltinf, olinf, & tem1, tem2, ztmax1 - z1i = 1.0 / z1 + z1i = one / z1 tem1 = z0max/z1 - if (abs(1.0-tem1) > 1.0e-6) then - ztmax1 = - beta*log(tem1)/(alpha2*(1.-tem1)) + if (abs(one-tem1) > 1.0d-6) then + ztmax1 = - beta*log(tem1)/(alpha2*(one-tem1)) else - ztmax1 = 99.0 + ztmax1 = 99.0d0 endif - if( z0max < 0.05 .and. snwdph < 10.0 ) ztmax1 = 99.0 + if( z0max < 0.05d0 .and. snwdph < 10.0d0 ) ztmax1 = 99.0d0 ! compute stability indices (rb and hlinf) dtv = thv1 - tvs - adtv = max(abs(dtv),0.001) + adtv = max(abs(dtv),0.001d0) dtv = sign(1.,dtv) * adtv #ifdef GSD_SURFACE_FLUXES_BUGFIX - rb = max(-5000.0, grav * dtv * z1 + rb = max(-5000.0d0, grav * dtv * z1 & / (thv1 * wind * wind)) #else - rb = max(-5000.0, (grav+grav) * dtv * z1 + rb = max(-5000.0d0, (grav+grav) * dtv * z1 & / ((thv1 + tvs) * wind * wind)) #endif - tem1 = 1.0 / z0max - tem2 = 1.0 / ztmax + tem1 = one / z0max + tem2 = one / ztmax fm = log((z0max+z1) * tem1) fh = log((ztmax+z1) * tem2) - fm10 = log((z0max+10.) * tem1) - fh2 = log((ztmax+2.) * tem2) + fm10 = log((z0max+10.0d0) * tem1) + fh2 = log((ztmax+2.0d0) * tem2) hlinf = rb * fm * fm / fh hlinf = min(max(hlinf,ztmin1),ztmax1) ! ! stable case ! - if (dtv >= 0.0) then + if (dtv >= zero) then hl1 = hlinf - if(hlinf > .25) then + if(hlinf > 0.25d0) then tem1 = hlinf * z1i hl0inf = z0max * tem1 hltinf = ztmax * tem1 - aa = sqrt(1. + alpha4 * hlinf) - aa0 = sqrt(1. + alpha4 * hl0inf) + aa = sqrt(one + alpha4 * hlinf) + aa0 = sqrt(one + alpha4 * hl0inf) bb = aa - bb0 = sqrt(1. + alpha4 * hltinf) - pm = aa0 - aa + log( (aa + 1.)/(aa0 + 1.) ) - ph = bb0 - bb + log( (bb + 1.)/(bb0 + 1.) ) + bb0 = sqrt(one + alpha4 * hltinf) + pm = aa0 - aa + log( (aa + one)/(aa0 + one) ) + ph = bb0 - bb + log( (bb + one)/(bb0 + one) ) fms = fm - pm fhs = fh - ph hl1 = fms * fms * rb / fhs @@ -447,27 +451,27 @@ subroutine stability & tem1 = hl1 * z1i hl0 = z0max * tem1 hlt = ztmax * tem1 - aa = sqrt(1. + alpha4 * hl1) - aa0 = sqrt(1. + alpha4 * hl0) + aa = sqrt(one + alpha4 * hl1) + aa0 = sqrt(one + alpha4 * hl0) bb = aa - bb0 = sqrt(1. + alpha4 * hlt) - pm = aa0 - aa + log( (1.0+aa)/(1.0+aa0) ) - ph = bb0 - bb + log( (1.0+bb)/(1.0+bb0) ) - hl110 = hl1 * 10. * z1i + bb0 = sqrt(one + alpha4 * hlt) + pm = aa0 - aa + log( (one+aa)/(one+aa0) ) + ph = bb0 - bb + log( (one+bb)/(one+bb0) ) + hl110 = hl1 * 10.0d0 * z1i hl110 = min(max(hl110, ztmin1), ztmax1) - aa = sqrt(1. + alpha4 * hl110) - pm10 = aa0 - aa + log( (1.0+aa)/(1.0+aa0) ) + aa = sqrt(one + alpha4 * hl110) + pm10 = aa0 - aa + log( (one+aa)/(one+aa0) ) hl12 = (hl1+hl1) * z1i hl12 = min(max(hl12,ztmin1),ztmax1) -! aa = sqrt(1. + alpha4 * hl12) - bb = sqrt(1. + alpha4 * hl12) - ph2 = bb0 - bb + log( (1.0+bb)/(1.0+bb0) ) +! aa = sqrt(one + alpha4 * hl12) + bb = sqrt(one + alpha4 * hl12) + ph2 = bb0 - bb + log( (one+bb)/(one+bb0) ) ! ! unstable case - check for unphysical obukhov length ! else ! dtv < 0 case olinf = z1 / hlinf - tem1 = 50.0 * z0max + tem1 = 50.0d0 * z0max if(abs(olinf) <= tem1) then hlinf = -z1 / tem1 hlinf = min(max(hlinf,ztmin1),ztmax1) @@ -475,30 +479,30 @@ subroutine stability & ! ! get pm and ph ! - if (hlinf >= -0.5) then + if (hlinf >= -0.5d0) then hl1 = hlinf - pm = (a0 + a1*hl1) * hl1 / (1.+ (b1+b2*hl1) *hl1) - ph = (a0p + a1p*hl1) * hl1 / (1.+ (b1p+b2p*hl1)*hl1) - hl110 = hl1 * 10. * z1i + pm = (a0 + a1*hl1) * hl1 / (one+ (b1+b2*hl1) *hl1) + ph = (a0p + a1p*hl1) * hl1 / (one+ (b1p+b2p*hl1)*hl1) + hl110 = hl1 * 10.0d0 * z1i hl110 = min(max(hl110, ztmin1), ztmax1) - pm10 = (a0 + a1*hl110) * hl110 / (1.+(b1+b2*hl110)*hl110) + pm10 = (a0 + a1*hl110) * hl110/(one+(b1+b2*hl110)*hl110) hl12 = (hl1+hl1) * z1i hl12 = min(max(hl12, ztmin1), ztmax1) - ph2 = (a0p + a1p*hl12) * hl12 / (1.+(b1p+b2p*hl12)*hl12) + ph2 = (a0p + a1p*hl12) * hl12/(one+(b1p+b2p*hl12)*hl12) else ! hlinf < 0.05 hl1 = -hlinf - tem1 = 1.0 / sqrt(hl1) - pm = log(hl1) + 2. * sqrt(tem1) - .8776 - ph = log(hl1) + .5 * tem1 + 1.386 + tem1 = one / sqrt(hl1) + pm = log(hl1) + 2.0d0 * sqrt(tem1) - .8776d0 + ph = log(hl1) + 0.5d0 * tem1 + 1.386d0 ! pm = log(hl1) + 2.0 * hl1 ** (-.25) - .8776 ! ph = log(hl1) + 0.5 * hl1 ** (-.5) + 1.386 - hl110 = hl1 * 10. * z1i + hl110 = hl1 * 10.0d0 * z1i hl110 = min(max(hl110, ztmin1), ztmax1) - pm10 = log(hl110) + 2.0 / sqrt(sqrt(hl110)) - .8776 + pm10 = log(hl110) + 2.0d0 / sqrt(sqrt(hl110)) - 0.8776d0 ! pm10 = log(hl110) + 2. * hl110 ** (-.25) - .8776 hl12 = (hl1+hl1) * z1i hl12 = min(max(hl12, ztmin1), ztmax1) - ph2 = log(hl12) + 0.5 / sqrt(hl12) + 1.386 + ph2 = log(hl12) + 0.5d0 / sqrt(hl12) + 1.386d0 ! ph2 = log(hl12) + .5 * hl12 ** (-.5) + 1.386 endif @@ -512,7 +516,7 @@ subroutine stability & fh2 = fh2 - ph2 cm = ca * ca / (fm * fm) ch = ca * ca / (fm * fh) - tem1 = 0.00001/z1 + tem1 = 0.00001d0/z1 cm = max(cm, tem1) ch = max(ch, tem1) stress = cm * wind * wind diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 75afaa6ff..9f2170e80 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -194,14 +194,16 @@ subroutine lsm_noah_run & implicit none ! --- constant parameters: - real(kind=kind_phys), parameter :: rhoh2o = 1000.0 - real(kind=kind_phys), parameter :: a2 = 17.2693882 - real(kind=kind_phys), parameter :: a3 = 273.16 - real(kind=kind_phys), parameter :: a4 = 35.86 + real(kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 + real(kind=kind_phys), parameter :: rhoh2o = 1000.0d0 + real(kind=kind_phys), parameter :: a2 = 17.2693882d0 + real(kind=kind_phys), parameter :: a3 = 273.16d0 + real(kind=kind_phys), parameter :: a4 = 35.86d0 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) + real(kind=kind_phys), parameter :: qmin = 1.0d-8 real(kind=kind_phys), save :: zsoil_noah(4) - data zsoil_noah / -0.1, -0.4, -1.0, -2.0 / + data zsoil_noah / -0.1d0, -0.4d0, -1.0d0, -2.0d0 / ! --- input: integer, intent(in) :: im, km, isot, ivegsrc @@ -266,9 +268,9 @@ subroutine lsm_noah_run & ! !===> ... begin here ! - cpinv = 1.0/cp - hvapi = 1.0/hvap - elocp = hvap/cp + cpinv = one/cp + hvapi = one/hvap + elocp = hvap/cp !> - Initialize CCPP error handling variables @@ -298,19 +300,19 @@ subroutine lsm_noah_run & do i = 1, im if (flag_iter(i) .and. land(i)) then - ep(i) = 0.0 - evap (i) = 0.0 - hflx (i) = 0.0 - gflux(i) = 0.0 - drain(i) = 0.0 - canopy(i) = max(canopy(i), 0.0) - - evbs (i) = 0.0 - evcw (i) = 0.0 - trans(i) = 0.0 - sbsno(i) = 0.0 - snowc(i) = 0.0 - snohf(i) = 0.0 + ep(i) = zero + evap (i) = zero + hflx (i) = zero + gflux(i) = zero + drain(i) = zero + canopy(i) = max(canopy(i), zero) + + evbs (i) = zero + evcw (i) = zero + trans(i) = zero + sbsno(i) = zero + snowc(i) = zero + snohf(i) = zero endif ! flag_iter & land enddo @@ -318,12 +320,12 @@ subroutine lsm_noah_run & do i = 1, im if (flag_iter(i) .and. land(i)) then - q0(i) = max(q1(i), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) + q0(i) = max(q1(i), qmin) !* q1=specific humidity at level 1 (kg/kg) theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) - rho(i) = prsl1(i) / (rd*t1(i)*(1.0+rvrdm1*q0(i))) + rho(i) = prsl1(i) / (rd*t1(i)*(one+rvrdm1*q0(i))) qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) - qs1(i) = max(eps*qs1(i) / (prsl1(i)+epsm1*qs1(i)), 1.e-8) + qs1(i) = max(eps*qs1(i) / (prsl1(i)+epsm1*qs1(i)), qmin) q0 (i) = min(qs1(i), q0(i)) endif ! flag_iter & land enddo @@ -422,12 +424,12 @@ subroutine lsm_noah_run & !! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper !! or lower bound. vegfp = vegfpert(i) ! sfc-perts, mgehne - if (pertvegf(1)>0.0) then + if (pertvegf(1) > zero) then ! compute beta distribution parameters for vegetation fraction mv = shdfac sv = pertvegf(1)*mv*(1.-mv) - alphav = mv*mv*(1.0-mv)/(sv*sv)-mv - betav = alphav*(1.0-mv)/mv + alphav = mv*mv*(one-mv)/(sv*sv)-mv + betav = alphav*(one-mv)/mv ! compute beta distribution value corresponding ! to the given percentile albPpert to use as new albedo call ppfbet(vegfp,alphav,betav,iflag,vegftmp) @@ -439,7 +441,7 @@ subroutine lsm_noah_run & shdmax1d = shdmax(i) snoalb1d = snoalb(i) - ptu = 0.0 + ptu = zero alb = sfalb(i) tbot = tg3(i) @@ -456,7 +458,7 @@ subroutine lsm_noah_run & ! cm - surface exchange coefficient for momentum (\f$m s^{-1}\f$) -> cmx ! z0 - surface roughness (\f$m\f$) -> zorl(\f$cm\f$) - cmc = canopy(i) * 0.001 ! convert from mm to m + cmc = canopy(i) * 0.001d0 ! convert from mm to m tsea = tsurf(i) ! clu_q2m_iter do k = 1, km @@ -465,10 +467,10 @@ subroutine lsm_noah_run & slsoil(k) = slc(i,k) enddo - snowh = snwdph(i) * 0.001 ! convert from mm to m - sneqv = weasd(i) * 0.001 ! convert from mm to m - if (sneqv /= 0.0 .and. snowh == 0.0) then - snowh = 10.0 * sneqv + snowh = snwdph(i) * 0.001d0 ! convert from mm to m + sneqv = weasd(i) * 0.001d0 ! convert from mm to m + if (sneqv /= zero .and. snowh == zero) then + snowh = 10.0d0 * sneqv endif chx = ch(i) * wind(i) ! compute conductance @@ -477,7 +479,7 @@ subroutine lsm_noah_run & cmm(i) = cmx ! ---- ... outside sflx, roughness uses cm as unit - z0 = zorl(i)/100. + z0 = zorl(i) * 0.01d0 ! ---- mgehne, sfc-perts ! - Apply perturbation of soil type b parameter and leave area index. bexpp = bexppert(i) ! sfc perts, mgehne @@ -522,7 +524,7 @@ subroutine lsm_noah_run & trans(i) = ett sbsno(i) = esnow snowc(i) = sncovr - stm(i) = soilm * 1000.0 ! unit conversion (from m to kg m-2) + stm(i) = soilm * 1000.0d0 ! unit conversion (from m to kg m-2) snohf(i) = flx1 + flx2 + flx3 smcwlt2(i) = smcwlt @@ -539,17 +541,17 @@ subroutine lsm_noah_run & wet1(i) = smsoil(1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) ! --- ... unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) - runoff(i) = runoff1 * 1000.0 - drain (i) = runoff2 * 1000.0 + runoff(i) = runoff1 * 1000.0d0 + drain (i) = runoff2 * 1000.0d0 ! --- ... unit conversion (from m to mm) - canopy(i) = cmc * 1000.0 - snwdph(i) = snowh * 1000.0 - weasd(i) = sneqv * 1000.0 + canopy(i) = cmc * 1000.0d0 + snwdph(i) = snowh * 1000.0d0 + weasd(i) = sneqv * 1000.0d0 sncovr1(i) = sncovr ! ---- ... outside sflx, roughness uses cm as unit (update after snow's ! effect) - zorl(i) = z0*100. + zorl(i) = z0*100.0d0 !> - Do not return the following output fields to parent model: !!\n ec - canopy water evaporation (m s-1) @@ -606,7 +608,7 @@ subroutine lsm_noah_run & !! flux (\a evap). do i = 1, im if (flag_iter(i) .and. land(i)) then - tem = 1.0 / rho(i) + tem = one / rho(i) hflx(i) = hflx(i) * tem * cpinv evap(i) = evap(i) * tem * hvapi endif ! flag_iter & land diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 9635f30b8..ba0aec030 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -23,7 +23,7 @@ end subroutine sfc_ocean_finalize subroutine sfc_ocean_run & !................................... ! --- inputs: - & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & + & ( im, rd, eps, epsm1, rvrdm1, ps, t1, q1, & & tskin, cm, ch, prsl1, prslki, wet, wind, & & flag_iter, & ! --- outputs: @@ -90,10 +90,12 @@ subroutine sfc_ocean_run & ! implicit none +! --- constant parameters: + real (kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 & + &, qmin = 1.0d-8 ! --- inputs: integer, intent(in) :: im - real (kind=kind_phys), intent(in) :: cp, rd, eps, epsm1, hvap, & - & rvrdm1 + real (kind=kind_phys), intent(in) :: rd, eps, epsm1, rvrdm1 real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, tskin, cm, ch, prsl1, prslki, wind @@ -109,17 +111,11 @@ subroutine sfc_ocean_run & ! --- locals: - real (kind=kind_phys) :: q0, qss, rch, rho, tem, cpinv, & - & hvapi, elocp + real (kind=kind_phys) :: q0, qss, rch, rho, tem integer :: i - logical :: flag(im) -! !===> ... begin here - cpinv = 1.0/cp - hvapi = 1.0/hvap - elocp = hvap/cp ! ! -- ... initialize CCPP error handling variables errmsg = '' @@ -127,40 +123,32 @@ subroutine sfc_ocean_run & ! ! --- ... flag for open water do i = 1, im - flag(i) = (wet(i) .and. flag_iter(i)) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface - if ( flag(i) ) then - q0 = max( q1(i), 1.0e-8 ) - rho = prsl1(i) / (rd*t1(i)*(1.0 + rvrdm1*q0)) + if (wet(i) .and. flag_iter(i)) then + q0 = max( q1(i), qmin ) + rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) qss = fpvs( tskin(i) ) qss = eps*qss / (ps(i) + epsm1*qss) - evap(i) = 0.0 - hflx(i) = 0.0 - ep(i) = 0.0 - gflux(i) = 0.0 - ! --- ... rcp = rho cp ch v - rch = rho * cp * ch(i) * wind(i) + tem = ch(i) * wind(i) cmm(i) = cm(i) * wind(i) - chh(i) = rho * ch(i) * wind(i) + chh(i) = rho * tem ! --- ... sensible and latent heat flux over open water - hflx(i) = rch * (tskin(i) - t1(i) * prslki(i)) + hflx(i) = tem * (tskin(i) - t1(i) * prslki(i)) - evap(i) = elocp*rch * (qss - q0) - qsurf(i) = qss + evap(i) = tem * (qss - q0) - tem = 1.0 / rho - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi + ep(i) = evap(i) + qsurf(i) = qss endif enddo ! diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index d60c1ce2c..096454f7a 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -19,15 +19,6 @@ type = integer intent = in optional = F -[cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [rd] standard_name = gas_constant_dry_air long_name = ideal gas constant for dry air @@ -55,15 +46,6 @@ kind = kind_phys intent = in optional = F -[hvap] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of evaporation/sublimation - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [rvrdm1] standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 750a6d795..db483ee75 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -146,6 +146,7 @@ subroutine sfc_sice_run & real(kind=kind_phys), parameter :: timin = 173.0d0 !< minimum temperature allowed for snow/ice real(kind=kind_phys), parameter :: albfw = 0.06d0 !< albedo for lead real(kind=kind_phys), parameter :: dsi = one/0.33d0 + real(kind=kind_phys), parameter :: qmin = 1.0d-8 ! --- inputs: integer, intent(in) :: im, km, ipr @@ -231,7 +232,7 @@ subroutine sfc_sice_run & if (flag(i)) then if (srflag(i) > zero) then ep(i) = ep(i)*(one-srflag(i)) - weasd(i) = weasd(i) + 1.e3*tprcp(i)*srflag(i) + weasd(i) = weasd(i) + 1.0d3*tprcp(i)*srflag(i) tprcp(i) = tprcp(i)*(one-srflag(i)) endif endif @@ -260,7 +261,7 @@ subroutine sfc_sice_run & ! dlwflx has been given a negative sign for downward longwave ! sfcnsw is the net shortwave flux (direction: dn-up) - q0 = max(q1(i), 1.0e-8) + q0 = max(q1(i), qmin) ! tsurf(i) = tskin(i) #ifdef GSD_SURFACE_FLUXES_BUGFIX theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer @@ -269,7 +270,7 @@ subroutine sfc_sice_run & #endif rho(i) = prsl1(i) / (rd*t1(i)*(one+rvrdm1*q0)) qs1 = fpvs(t1(i)) - qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), 1.e-8) + qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), qmin) q0 = min(qs1, q0) if (fice(i) < cimin) then @@ -279,7 +280,7 @@ subroutine sfc_sice_run & tskin(i)= tgice print *,'fix ice fraction: reset it to:', fice(i) endif - ffw(i) = 1.0 - fice(i) + ffw(i) = one - fice(i) qssi = fpvs(tice(i)) qssi = eps*qssi / (ps(i) + epsm1*qssi) @@ -309,7 +310,7 @@ subroutine sfc_sice_run & ! evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) snetw(i) = sfcdsw(i) * (one - albfw) - snetw(i) = min(3.0*sfcnsw(i)/(one+2.0d0*ffw(i)), snetw(i)) + snetw(i) = min(3.0d0*sfcnsw(i)/(one+2.0d0*ffw(i)), snetw(i)) !> - Calculate net solar incoming at top \a sneti. sneti(i) = (sfcnsw(i) - ffw(i)*snetw(i)) / fice(i) @@ -416,10 +417,10 @@ subroutine sfc_sice_run & ! --- ... convert snow depth back to mm of water equivalent - weasd(i) = snowd(i) * 1000.0 + weasd(i) = snowd(i) * 1000.0d0 snwdph(i) = weasd(i) * dsi ! snow depth in mm - tem = 1.0 / rho(i) + tem = one / rho(i) hflx(i) = hflx(i) * tem * cpinv evap(i) = evap(i) * tem * hvapi endif @@ -530,7 +531,7 @@ subroutine ice3lay real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di real (kind=kind_phys), parameter :: ci = 2054.0d0 !< heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34e5 !< latent heat of fusion (j/kg-ice) + real (kind=kind_phys), parameter :: li = 3.34d5 !< latent heat of fusion (j/kg-ice) real (kind=kind_phys), parameter :: si = 1.0d0 !< salinity of sea ice real (kind=kind_phys), parameter :: mu = 0.054d0 !< relates freezing temp to salinity real (kind=kind_phys), parameter :: tfi = -mu*si !< sea ice freezing temp = -mu*salinity @@ -573,9 +574,9 @@ subroutine ice3lay ! !===> ... begin here ! - dt2 = 2.0d0 * delt - dt4 = 4.0d0 * delt - dt6 = 6.0d0 * delt + dt2 = delt + delt + dt4 = dt2 + dt2 + dt6 = dt2 + dt4 dt2i = one / dt2 do i = 1, im From c316f79bfb86630513d460a898ca59d897406f90 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 21 Apr 2020 01:40:22 +0000 Subject: [PATCH 10/97] removing some unneeded do loops in sfc_drv.f - results reproduce --- physics/sfc_drv.f | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 9f2170e80..f52b6d829 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -313,13 +313,9 @@ subroutine lsm_noah_run & sbsno(i) = zero snowc(i) = zero snohf(i) = zero - endif ! flag_iter & land - enddo !> - initialize variables wind, q, and rh at level 1. - do i = 1, im - if (flag_iter(i) .and. land(i)) then q0(i) = max(q1(i), qmin) !* q1=specific humidity at level 1 (kg/kg) theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) @@ -327,19 +323,10 @@ subroutine lsm_noah_run & qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) qs1(i) = max(eps*qs1(i) / (prsl1(i)+epsm1*qs1(i)), qmin) q0 (i) = min(qs1(i), q0(i)) - endif ! flag_iter & land - enddo - do i = 1, im - if (flag_iter(i) .and. land(i)) then do k = 1, km zsoil(i,k) = zsoil_noah(k) enddo - endif ! flag_iter & land - enddo - - do i = 1, im - if (flag_iter(i) .and. land(i)) then !> - Prepare variables to run Noah LSM: !! - 1. configuration information (c): @@ -592,25 +579,20 @@ subroutine lsm_noah_run & !!\n nroot - number of root layers, a function of veg type, determined !! in subroutine redprm. - endif ! end if flag_iter and flag - enddo ! end do_i_loop +! endif ! end if flag_iter and flag +! enddo ! end do_i_loop !> - Compute specific humidity at surface (\a qsurf). - do i = 1, im - if (flag_iter(i) .and. land(i)) then rch(i) = rho(i) * cp * ch(i) * wind(i) qsurf(i) = q1(i) + evap(i) / (elocp * rch(i)) - endif ! flag_iter & land - enddo !> - Compute surface upward sensible heat flux (\a hflx) and evaporation !! flux (\a evap). - do i = 1, im - if (flag_iter(i) .and. land(i)) then tem = one / rho(i) hflx(i) = hflx(i) * tem * cpinv evap(i) = evap(i) * tem * hvapi + endif ! flag_iter & land enddo From 5953c522b25ebc8a4424fbb54c4df21b4f38834d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Apr 2020 01:32:06 +0000 Subject: [PATCH 11/97] updating precision of constants in several physics routines --- physics/GFS_MP_generic.F90 | 16 +-- physics/GFS_suite_interstitial.F90 | 77 +++++----- physics/GFS_surface_composites.F90 | 10 +- physics/GFS_surface_generic.F90 | 39 +++-- physics/m_micro.F90 | 223 +++++++++++++++-------------- physics/micro_mg3_0.F90 | 19 ++- physics/moninshoc.f | 40 +++--- physics/sfc_drv.f | 42 +++--- physics/sfc_ocean.F | 4 +- physics/sfc_sice.f | 76 +++++----- 10 files changed, 277 insertions(+), 269 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index bcf11db66..ffbe6ab9b 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -140,15 +140,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt integer, intent(out) :: errflg ! DH* TODO: CLEANUP, all of these should be coming in through the argument list - real(kind=kind_phys), parameter :: con_p001= 0.001d0 - real(kind=kind_phys), parameter :: con_day = 86400.0d0 - real(kind=kind_phys), parameter :: rainmin = 1.0d-13 - real(kind=kind_phys), parameter :: p850 = 85000.0d0 + real(kind=kind_phys), parameter :: con_p001= 0.001_kind_phys + real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys + real(kind=kind_phys), parameter :: rainmin = 1.0e-13_kind_phys + real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys ! *DH integer :: i, k, ic - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2 real(kind=kind_phys), dimension(im) :: domr, domzr, domip, doms, t850, work1 @@ -267,7 +267,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do i = 1, im !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) - if (tsfc(i) >= 273.15d0) then + if (tsfc(i) >= 273.15_kind_phys) then crain = rainc(i) csnow = zero else @@ -295,7 +295,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (rain(i) > rainmin) then tem1 = max(zero, (rain(i)-rainc(i))) * sr(i) tem2 = one / rain(i) - if (t850(i) > 273.16d0) then + if (t850(i) > 273.16_kind_phys) then srflag(i) = max(zero, min(one, tem1*tem2)) else srflag(i) = max(zero, min(one, (tem1+rainc(i))*tem2)) @@ -311,7 +311,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do i = 1, im tprcp(i) = max(zero, rain(i) ) ! clu: rain -> tprcp srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) - if (t850(i) <= 273.16d0) then + if (t850(i) <= 273.16_kind_phys) then srflag(i) = one ! clu: set srflag to 'snow' (i.e. 1) endif enddo diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index a8d5f5b8b..f6c4c5c7a 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -100,6 +100,7 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, real(kind=kind_phys), intent(out), dimension(im) :: work1, work2, psurf real(kind=kind_phys), intent(out), dimension(im,levs) :: dudt, dvdt, dtdt, dtdtc real(kind=kind_phys), intent(out), dimension(im,levs,ntrac) :: dqdt + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -114,23 +115,23 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, islmsk(i) = nint(slmsk(i)) work1(i) = (log(area(i)) - dxmin) * dxinv - work1(i) = max(0.0, min(1.0,work1(i))) - work2(i) = 1.0 - work1(i) + work1(i) = max(zero, min(one, work1(i))) + work2(i) = one - work1(i) psurf(i) = pgr(i) end do do k=1,levs do i=1,im - dudt(i,k) = 0. - dvdt(i,k) = 0. - dtdt(i,k) = 0. - dtdtc(i,k) = 0. + dudt(i,k) = zero + dvdt(i,k) = zero + dtdt(i,k) = zero + dtdtc(i,k) = zero enddo enddo do n=1,ntrac do k=1,levs do i=1,im - dqdt(i,k,n) = 0. + dqdt(i,k,n) = zero enddo enddo enddo @@ -143,7 +144,6 @@ end module GFS_suite_interstitial_1 module GFS_suite_interstitial_2 use machine, only: kind_phys - real(kind=kind_phys), parameter :: one = 1.0d0 contains @@ -195,13 +195,14 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer, intent(out) :: errflg ! local variables - real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) + real(kind=kind_phys), parameter :: czmin = 0.0001_kind_phys ! cos(89.994) integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn real(kind=kind_phys), dimension(im) :: tx1, tx2 - real(kind=kind_phys), parameter :: qmin = 1.0d-10, epsln=1.0d-10 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: qmin = 1.0e-10_kind_phys, epsln=1.0e-10_kind_phys ! Initialize CCPP error handling variables errmsg = '' @@ -218,7 +219,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do i = 1, im if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg tem1 = adjsfcdsw(i) / xcosz(i) - if ( tem1 >= 120.0 ) then + if ( tem1 >= 120.0_kind_phys ) then suntim(i) = suntim(i) + dtf endif endif @@ -295,9 +296,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do i=1, im invrsn(i) = .false. - tx1(i) = 0.0 - tx2(i) = 10.0 - ctei_r(i) = 10.0 + tx1(i) = zero + tx2(i) = 10.0_kind_phys + ctei_r(i) = 10.0_kind_phys enddo if ((((imfshalcnv == 0 .and. shal_cnv) .or. old_monin) .and. mstrat) & @@ -305,13 +306,13 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ctei_rml(:) = ctei_rm(1)*work1(:) + ctei_rm(2)*work2(:) do k=1,levs/2 do i=1,im - if (prsi(i,1)-prsi(i,k+1) < 0.35*prsi(i,1) & + if (prsi(i,1)-prsi(i,k+1) < 0.35_kind_phys*prsi(i,1) & .and. (.not. invrsn(i))) then tem = (tgrs(i,k+1) - tgrs(i,k)) & / (prsl(i,k) - prsl(i,k+1)) - if (((tem > 0.00010) .and. (tx1(i) < 0.0)) .or. & - ((tem-abs(tx1(i)) > 0.0) .and. (tx2(i) < 0.0))) then + if (((tem > 0.0001_kind_phys) .and. (tx1(i) < zero)) .or. & + ((tem-abs(tx1(i)) > zero) .and. (tx2(i) < zero))) then invrsn(i) = .true. if (qgrs_water_vapor(i,k) > qgrs_water_vapor(i,k+1)) then @@ -321,10 +322,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl tem1 = tem1 / prslk(i,k+1) - tem2 / prslk(i,k) ! --- ... (cp/l)(deltathetae)/(deltatwater) > ctei_rm -> conditon for CTEI - ctei_r(i) = (1.0/hocp)*tem1/(qgrs_water_vapor(i,k+1)-qgrs_water_vapor(i,k) & + ctei_r(i) = (one/hocp)*tem1/(qgrs_water_vapor(i,k+1)-qgrs_water_vapor(i,k) & + qgrs_cloud_water(i,k+1)-qgrs_cloud_water(i,k)) else - ctei_r(i) = 10 + ctei_r(i) = 10.0_kind_phys endif if ( ctei_rml(i) > ctei_r(i) ) then @@ -505,8 +506,9 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & !real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.04, & ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 ! in the following inverse of slope_mg and slope_upmg are specified - real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & - slope_upmg = 25.0_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: slope_mg = 50.0_kind_phys, & + slope_upmg = 25.0_kind_phys ! Initialize CCPP error handling variables errmsg = '' @@ -558,10 +560,10 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & endif ! end if_ras or cfscnv or samf if (ntcw > 0) then - if (imp_physics == imp_physics_mg .and. rhcpbl < 0.5) then ! compute rhc for GMAO macro physics cloud pdf + if (imp_physics == imp_physics_mg .and. rhcpbl < 0.5_kind_phys) then ! compute rhc for GMAO macro physics cloud pdf do i=1,im - tx1(i) = 1.0 / prsi(i,1) - tx2(i) = 1.0 - rhcmax*work1(i)-rhcbot*work2(i) + tx1(i) = one / prsi(i,1) + tx2(i) = one - rhcmax*work1(i)-rhcbot*work2(i) kk = min(kinver(i), max(2,kpbl(i))) tx3(i) = prsi(i,kk)*tx1(i) @@ -570,18 +572,18 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & do k = 1, levs do i = 1, im tem = prsl(i,k) * tx1(i) - tem1 = min(max((tem-tx3(i))*slope_mg, -20.0), 20.0) + tem1 = min(max((tem-tx3(i))*slope_mg, -20.0_kind_phys), 20.0_kind_phys) ! Using rhcpbl and rhctop from the namelist instead of 0.3 and 0.2 ! and rhcbot represents pbl top critical relative humidity - tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0), 20.0) ! Anning + tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0_kind_phys), 20.0_kind_phys) ! Anning if (islmsk(i) > 0) then - tem1 = 1.0 / (1.0+exp(tem1+tem1)) + tem1 = one / (one+exp(tem1+tem1)) else - tem1 = 2.0 / (1.0+exp(tem1+tem1)) + tem1 = 2.0_kind_phys / (one+exp(tem1+tem1)) endif - tem2 = 1.0 / (1.0+exp(tem2)) + tem2 = one / (one+exp(tem2)) - rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) + rhc(i,k) = min(rhcmax, max(0.7_kind_phys, one-tx2(i)*tem1*tem2)) enddo enddo else @@ -589,12 +591,12 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & do i=1,im kk = max(10,kpbl(i)) if (k < kk) then - tem = rhcbot - (rhcbot-rhcpbl) * (1.0-prslk(i,k)) / (1.0-prslk(i,kk)) + tem = rhcbot - (rhcbot-rhcpbl) * (one-prslk(i,k)) / (one-prslk(i,kk)) else tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / prslk(i,kk) endif tem = rhcmax * work1(i) + tem * work2(i) - rhc(i,k) = max(0.0, min(1.0,tem)) + rhc(i,k) = max(zero, min(one,tem)) enddo enddo endif @@ -641,7 +643,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! prautco_l(i) = Model%prautco(1)*work1(i) + Model%prautco(2)*work2(i) ! enddo !*GF - rhc(:,:) = 1.0 + rhc(:,:) = one endif ! end if_ntcw end subroutine GFS_suite_interstitial_3_run @@ -688,6 +690,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! dqdti may not be allocated real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -745,16 +748,16 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to do k=1,levs do i=1,im gq0(i,k,ntlnc) = gq0(i,k,ntlnc) & - + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm + + max(zero, (clw(i,k,2)-save_qc(i,k))) / liqm gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(zero, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo else do k=1,levs do i=1,im gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(zero, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo endif @@ -779,7 +782,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to if (cplchm) then do k=1,levs do i=1,im - dqdti(i,k) = dqdti(i,k) * (1.0 / dtf) + dqdti(i,k) = dqdti(i,k) * (one / dtf) enddo enddo endif diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index c98650b99..e12543328 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -11,7 +11,7 @@ module GFS_surface_composites_pre public GFS_surface_composites_pre_init, GFS_surface_composites_pre_finalize, GFS_surface_composites_pre_run - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, epsln = 1.0e-10_kind_phys contains @@ -158,7 +158,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl ! snowd_ocn(i) = snowd(i) weasd_ocn(i) = zero snowd_ocn(i) = zero - semis_ocn(i) = 0.984d0 + semis_ocn(i) = 0.984_kind_phys endif if (dry(i)) then ! Land uustar_lnd(i) = uustar(i) @@ -178,7 +178,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl snowd_ice(i) = snowd(i) ep1d_ice(i) = zero gflx_ice(i) = zero - semis_ice(i) = 0.95d0 + semis_ice(i) = 0.95_kind_phys endif enddo @@ -278,7 +278,7 @@ module GFS_surface_composites_post public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys contains @@ -357,7 +357,7 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_ocn(i) fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_ocn(i) fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_ocn(i) chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_ocn(i) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 9cdf14d85..116b3e29f 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -11,8 +11,7 @@ module GFS_surface_generic_pre public GFS_surface_generic_pre_init, GFS_surface_generic_pre_finalize, GFS_surface_generic_pre_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys contains @@ -103,24 +102,24 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Set initial quantities for stochastic physics deltas if (do_sppt) then - dtdtr = 0.0 + dtdtr = zero endif ! Scale random patterns for surface perturbations with perturbation size ! Turn vegetation fraction pattern into percentile pattern if (do_sfcperts) then - if (pertz0(1) > 0.) then + if (pertz0(1) > zero) then z01d(:) = pertz0(1) * sfc_wts(:,1) ! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) ! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) endif - if (pertzt(1) > 0.) then + if (pertzt(1) > zero) then zt1d(:) = pertzt(1) * sfc_wts(:,2) endif - if (pertshc(1) > 0.) then + if (pertshc(1) > zero) then bexp1d(:) = pertshc(1) * sfc_wts(:,3) endif - if (pertlai(1) > 0.) then + if (pertlai(1) > zero) then xlai1d(:) = pertlai(1) * sfc_wts(:,4) endif ! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! @@ -130,7 +129,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! alb1d(i) = cdfz ! enddo ! endif - if (pertvegf(1) > 0.) then + if (pertvegf(1) > zero) then do i=1,im call cdfnor(sfc_wts(i,6),cdfz) vegf1d(i) = cdfz @@ -141,7 +140,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! End of stochastic physics / surface perturbation do i=1,im - sigmaf(i) = max(vfrac(i),0.01 ) + sigmaf(i) = max(vfrac(i), 0.01_kind_phys) if (islmsk(i) == 2) then if (isot == 1) then soiltyp(i) = 16 @@ -155,9 +154,9 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, endif slopetyp(i) = 9 else - soiltyp(i) = int( stype(i)+0.5 ) - vegtype(i) = int( vtype(i)+0.5 ) - slopetyp(i) = int( slope(i)+0.5 ) !! clu: slope -> slopetyp + soiltyp(i) = int( stype(i)+0.5_kind_phys ) + vegtype(i) = int( vtype(i)+0.5_kind_phys ) + slopetyp(i) = int( slope(i)+0.5_kind_phys ) !! clu: slope -> slopetyp if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 if (slopetyp(i) < 1) slopetyp(i) = 1 @@ -171,7 +170,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, smcref2(i) = zero wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & - + max(zero, min(cnvwind(i), 30.0)), one) + + max(zero, min(cnvwind(i), 30.0_kind_phys)), one) !wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & ! Statein%vgrs(i,1)*Statein%vgrs(i,1)) & ! + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) @@ -201,7 +200,7 @@ module GFS_surface_generic_post public GFS_surface_generic_post_init, GFS_surface_generic_post_finalize, GFS_surface_generic_post_run - real(kind=kind_phys), parameter :: zero = 0.0, one = 1.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys contains @@ -246,7 +245,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: albdf = 0.06d0 + real(kind=kind_phys), parameter :: albdf = 0.06_kind_phys integer :: i real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl @@ -305,11 +304,11 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt if (wet(i)) then ! some open water ! --- compute open water albedo xcosz_loc = max( zero, min( one, xcosz(i) )) - ocalnirdf_cpl = 0.06d0 - ocalnirbm_cpl = max(albdf, 0.026d0/(xcosz_loc**1.7d0+0.065d0) & - & + 0.15d0 * (xcosz_loc-0.1d0) * (xcosz_loc-0.5d0) & + ocalnirdf_cpl = 0.06_kind_phys + ocalnirbm_cpl = max(albdf, 0.026_kind_phys/(xcosz_loc**1.7_kind_phys+0.065_kind_phys) & + & + 0.15_kind_phys * (xcosz_loc-0.1_kind_phys) * (xcosz_loc-0.5_kind_phys) & & * (xcosz_loc-one)) - ocalvisdf_cpl = 0.06d0 + ocalvisdf_cpl = 0.06_kind_phys ocalvisbm_cpl = ocalnirbm_cpl nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl) @@ -323,7 +322,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt nvisdfi_cpl(i) = adjvisdfd(i) - adjvisdfu(i) endif nswsfci_cpl(i) = nnirbmi_cpl(i) + nnirdfi_cpl(i) & - + nvisbmi_cpl(i) + nvisdfi_cpl(i) + + nvisbmi_cpl(i) + nvisdfi_cpl(i) nswsfc_cpl(i) = nswsfc_cpl(i) + nswsfci_cpl(i)*dtf nnirbm_cpl(i) = nnirbm_cpl(i) + nnirbmi_cpl(i)*dtf nnirdf_cpl(i) = nnirdf_cpl(i) + nnirdfi_cpl(i)*dtf diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 521070af7..ba7963e7d 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -175,12 +175,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !------------------------------------ ! input ! real, parameter :: r_air = 3.47d-3 - real, parameter :: one=1.0d0, oneb3=one/3.0d0, onebcp=one/cp, & - zero=0.0d0, half=0.5d0, onebg=one/grav, & - & kapa=rgas*onebcp, cpbg=cp/grav, & - & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & - & qsmall=1.0d-14, rainmin = 1.0d-13, & - & fourb3=4.0d0/3.0d0, RL_cub=1.0d-15, nmin=1.0d0 + real, parameter :: one=1.0_kind_phys, oneb3=one/3.0_kind_phys, onebcp=one/cp, & + zero=0.0_kind_phys, half=0.5_kind_phys, onebg=one/grav, & + & kapa=rgas*onebcp, cpbg=cp/grav, & + & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & + & qsmall=1.0e-14_kind_phys, rainmin = 1.0e-13_kind_phys, & + & fourb3=4.0_kind_phys/3.0_kind_phys, RL_cub=1.0e-15_kind_phys, & + & nmin=1.0_kind_phys integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag, iccn @@ -354,27 +355,27 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! real (kind=kind_phys), parameter :: disp_liu=2., ui_scale=1.0 & ! &, dcrit=20.0d-6 & - real (kind=kind_phys), parameter :: disp_liu=1.0d0 & - &, ui_scale=1.0d0 & - &, dcrit=1.0d-6 & + real (kind=kind_phys), parameter :: disp_liu=1.0_kind_phys & + &, ui_scale=1.0_kind_phys & + &, dcrit=1.0e-6_kind_phys & ! &, ts_autice=1800.0 & ! &, ts_autice=3600.0 & !time scale - &, ninstr8 = 0.1d6 & - &, ncnstr8 = 100.0d6 + &, ninstr8 = 0.1e6_kind_phys & + &, ncnstr8 = 100.0e6_kind_phys real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_r8 real(kind=kind_phys):: t_ice_denom - integer, dimension(1) :: lev_sed_strt ! sedimentation start level - real(kind=kind_phys), parameter :: sig_sed_strt=0.05d0 ! normalized pressure at sedimentation start + integer, dimension(1) :: lev_sed_strt ! sedimentation start level + real(kind=kind_phys), parameter :: sig_sed_strt=0.05_kind_phys ! normalized pressure at sedimentation start real(kind=kind_phys),dimension(3) :: ccn_diag real(kind=kind_phys),dimension(58) :: cloudparams integer, parameter :: CCN_PARAM=2, IN_PARAM=5 - real(kind=kind_phys), parameter ::fdust_drop=1.0d0, fsoot_drop=0.1d0 & - &, sigma_nuc_r8=0.28d0,SCLMFDFR=0.03d0 + real(kind=kind_phys), parameter ::fdust_drop=1.0_kind_phys, fsoot_drop=0.1_kind_phys & + &, sigma_nuc_r8=0.28_kind_phys,SCLMFDFR=0.03_kind_phys ! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1 type (AerProps), dimension (IM,LM) :: AeroProps @@ -440,7 +441,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,ll) CLCN(I,k) = CLCN_i(I,ll) CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) - PLO(i,k) = prsl_i(i,ll)*0.01d0 + PLO(i,k) = prsl_i(i,ll)*0.01_kind_phys zlo(i,k) = phil(i,ll) * onebg temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) @@ -455,7 +456,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) * 0.01d0 ! interface pressure in hPa + PLE(i,k) = prsi_i(i,ll) * 0.01_kind_phys ! interface pressure in hPa zet(i,k+1) = phii(i,ll) * onebg END DO END DO @@ -500,7 +501,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,k) CLCN(I,k) = CLCN_i(I,k) CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) - PLO(i,k) = prsl_i(i,k)*0.01d0 + PLO(i,k) = prsl_i(i,k)*0.01_kind_phys zlo(i,k) = phil(i,k) * onebg temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) @@ -514,7 +515,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO DO K=0, LM DO I = 1,IM - PLE(i,k) = prsi_i(i,k) * 0.01d0 ! interface pressure in hPa + PLE(i,k) = prsi_i(i,k) * 0.01_kind_phys ! interface pressure in hPa zet(i,k+1) = phii(i,k) * onebg END DO END DO @@ -553,17 +554,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif enddo @@ -577,8 +578,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I=1, IM DO K = LM-2, 10, -1 - If ((CNV_DQLDT(I,K) <= 1.0d-9) .and. & - & (CNV_DQLDT(I,K+1) > 1.0d-9)) then + If ((CNV_DQLDT(I,K) <= 1.0e-9_kind_phys) .and. & + & (CNV_DQLDT(I,K+1) > 1.0e-9_kind_phys)) then KCT(I) = K+1 exit end if @@ -658,7 +659,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=lm-1,1,-1 do i=1,im tx1 = half * (temp(i,l+1) + temp(i,l)) - kh(i,l) = 3.55d-7*tx1**2.5d0*(rgas*0.01d0) / ple(i,l) !kh molecule diff only needing refinement + kh(i,l) = 3.55e-7_kind_phys*tx1**2.5_kind_phys*(rgas*0.01_kind_phys) / ple(i,l) !kh molecule diff only needing refinement enddo end do do i=1,im @@ -667,8 +668,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo do L=LM,1,-1 do i=1,im - blk_l(i,l) = one / ( one/max(0.15d0*ZPBL(i),0.4d0*zlo(i,lm-1))& - & + one/(zlo(i,l)*0.4d0) ) + blk_l(i,l) = one / ( one/max(0.15_kind_phys*ZPBL(i),0.4_kind_phys*zlo(i,lm-1))& + & + one/(zlo(i,l)*0.4_kind_phys) ) SC_ICE(i,l) = one NCPL(i,l) = MAX( NCPL(i,l), zero) @@ -687,8 +688,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=1,lm - rhdfdar8(l) = 1.d-8 - rhu00r8(l) = 0.95d0 + rhdfdar8(l) = 1.e-8_kind_phys + rhu00r8(l) = 0.95_kind_phys ttendr8(l) = zero qtendr8(l) = zero @@ -733,8 +734,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if ( iccn == 2) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else - AERMASSMIX(:,:,1:5) = 1.0d-6 - AERMASSMIX(:,:,6:15) = 2.0d-14 + AERMASSMIX(:,:,1:5) = 1.0e-6_kind_phys + AERMASSMIX(:,:,6:15) = 2.0e-14_kind_phys end if !> - Call aerconversion1() call AerConversion1 (AERMASSMIX, AeroProps) @@ -753,23 +754,23 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kcldtopcvn = KCT(I) tausurf_gw = min(half*SQRT(TAUOROX(I)*TAUOROX(I) & - & + TAUOROY(I)*TAUOROY(I)), 10.0d0) + & + TAUOROY(I)*TAUOROY(I)), 10.0_kind_phys) do k=1,lm uwind_gw(k) = min(half*SQRT( U1(I,k)*U1(I,k) & - & + V1(I,k)*V1(I,k)), 50.0d0) + & + V1(I,k)*V1(I,k)), 50.0_kind_phys) ! tausurf_gw =tausurf_gw + max (tausurf_gw, min(0.5*SQRT(TAUX(I , J)**2+TAUY(I , J)**2), 10.0)*BKGTAU) !adds a minimum value from unresolved sources - pm_gw(k) = 100.0d0*PLO(I,k) + pm_gw(k) = 100.0_kind_phys*PLO(I,k) tm_gw(k) = TEMP(I,k) nm_gw(k) = zero rho_gw(k) = pm_gw(k) /(RGAS*tm_gw(k)) ter8(k) = TEMP(I,k) - plevr8(k) = 100.0d0*PLO(I,k) + plevr8(k) = 100.0_kind_phys*PLO(I,k) ndropr8(k) = NCPL(I,k) qir8(k) = QILS(I,k) + QICN(I,k) qcr8(k) = QLLS(I,k) + QLCN(I,k) @@ -780,27 +781,27 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & npre8(k) = zero - if (RAD_CF(I,k) > 0.01d0 .and. qir8(k) > zero) then + if (RAD_CF(I,k) > 0.01_kind_phys .and. qir8(k) > zero) then npre8(k) = NPRE_FRAC*NCPI(I,k) else npre8(k) = zero endif omegr8(k) = OMEGA(I,k) - lc_turb(k) = max(blk_l(I,k), 50.0d0) + lc_turb(k) = max(blk_l(I,k), 50.0_kind_phys) ! rad_cooling(k) = RADheat(I,k) if (npre8(k) > zero .and. qir8(k) > zero) then - dpre8(k) = ( qir8(k)/(6.0d0*npre8(k)*900.0d0*PI))**(one/3.0d0) + dpre8(k) = ( qir8(k)/(6.0_kind_phys*npre8(k)*900.0_kind_phys*PI))**(one/3.0_kind_phys) else - dpre8(k) = 1.0d-9 + dpre8(k) = 1.0e-9_kind_phys endif wparc_ls(k) = -omegr8(k) / (rho_gw(k)*GRAV) & & + cpbg * radheat(i,k) ! & + cpbg * rad_cooling(k) enddo do k=0,lm - pi_gw(k) = 100.0d0*PLE(I,k) + pi_gw(k) = 100.0_kind_phys*PLE(I,k) rhoi_gw(k) = zero ni_gw(k) = zero ti_gw(k) = zero @@ -816,13 +817,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & ti_gw, nm_gw, q1(i,:)) do k=1,lm - nm_gw(k) = max(nm_gw(k), 0.005d0) + nm_gw(k) = max(nm_gw(k), 0.005_kind_phys) h_gw(k) = k_gw*rho_gw(k)*uwind_gw(k)*nm_gw(k) if (h_gw(K) > zero) then - h_gw(K) = sqrt(2.0d0*tausurf_gw/h_gw(K)) + h_gw(K) = sqrt(2.0_kind_phys*tausurf_gw/h_gw(K)) end if - wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133d0 + wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133_kind_phys wparc_cgw(k) = zero end do @@ -839,14 +840,14 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do k=1,kcldtopcvn c2_gw = (nm_gw(k) + Nct) / Nct - wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56d0* & - & 1.806d0*c2_gw*c2_gw)*Wct*0.133d0 + wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56_kind_phys* & + & 1.806_kind_phys*c2_gw*c2_gw)*Wct*0.133_kind_phys enddo end if do k=1,lm - dummyW(k) = 0.133d0*k_gw*uwind_gw(k)/nm_gw(k) + dummyW(k) = 0.133_kind_phys*k_gw*uwind_gw(k)/nm_gw(k) enddo do K=1, LM-5, 1 @@ -866,17 +867,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kbmin = min(kbmin, LM-1) - 4 do K = 1, LM wparc_turb(k) = KH(I,k) / lc_turb(k) - dummyW(k) = 10.0d0 + dummyW(k) = 10.0_kind_phys enddo - if (FRLAND(I) < 0.1d0 .and. ZPBL(I) < 800.0d0 .and. & - & TEMP(I,LM) < 298.0d0 .and. TEMP(I,LM) > 274.0d0 ) then + if (FRLAND(I) < 0.1_kind_phys .and. ZPBL(I) < 800.0_kind_phys .and. & + & TEMP(I,LM) < 298.0_kind_phys .and. TEMP(I,LM) > 274.0_kind_phys) then do K = 1, LM - dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01d0,10.0d0),-10.0d0) + dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01_kind_phys, 10.0_kind_phys),-10.0_kind_phys) dummyW(k) = one / (one+exp(dummyW(k))) enddo maxkh = max(maxval(KH(I,kbmin:LM-1)*nm_gw(kbmin:LM-1)/ & - & 0.17d0), 0.3d0) + & 0.17_kind_phys), 0.3_kind_phys) do K = 1, LM wparc_turb(k) = (one-dummyW(k))*wparc_turb(k) & & + dummyW(k)*maxkh @@ -884,7 +885,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & end if - wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2d0) + wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2_kind_phys) @@ -902,11 +903,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do K = 1, LM - if (plevr8(K) > 70.0d0) then + if (plevr8(K) > 70.0_kind_phys) then - ccn_diag(1) = 0.001d0 - ccn_diag(2) = 0.004d0 - ccn_diag(3) = 0.01d0 + ccn_diag(1) = 0.001_kind_phys + ccn_diag(2) = 0.004_kind_phys + ccn_diag(3) = 0.01_kind_phys if (K > 2 .and. K <= LM-2) then tauxr8 = (ter8(K-1) + ter8(K+1) + ter8(K)) * oneb3 @@ -957,7 +958,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & swparc(K) = zero smaxicer8(K) = zero nheticer8(K) = zero - sc_icer8(K) = 2.0d0 + sc_icer8(K) = 2.0_kind_phys ! sc_icer8(K) = 1.0d0 naair8(K) = zero npccninr8(K) = zero @@ -974,9 +975,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! SMAXL(I,k) = smaxliq(k) * 100.0 ! SMAXI(I,k) = smaxicer8(k) * 100.0 - NHET_NUC(I,k) = nheticer8(k) * 1.0d-6 - NLIM_NUC(I,k) = nlimicer8(k) * 1.0d-6 - SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0d0) + NHET_NUC(I,k) = nheticer8(k) * 1.0e-6_kind_phys + NLIM_NUC(I,k) = nlimicer8(k) * 1.0e-6_kind_phys + SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0_kind_phys) ! SC_ICE(I,k) = min(max(sc_icer8(k),1.0),1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) @@ -986,13 +987,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (iccn == 0) then if(temp(i,k) < T_ICE_ALL) then ! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5d0) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5_kind_phys) elseif(temp(i,k) > TICE) then SC_ICE(i,k) = rhc(i,k) else ! SC_ICE(i,k) = 1.0 ! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5d0) + tx1 = max(SC_ICE(I,k), 1.5_kind_phys) SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & * t_ice_denom endif @@ -1003,12 +1004,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & endif NHET_IMM(I,k) = max(nhet_immr8(k), zero) DNHET_IMM(I,k) = max(dnhet_immr8(k), zero) - NHET_DEP(I,k) = nhet_depr8(k) * 1.0d-6 - NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0d-6 - DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0d-6 - DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0d-6 - DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0d-6 - WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8d0 + NHET_DEP(I,k) = nhet_depr8(k) * 1.0e-6_kind_phys + NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0e-6_kind_phys + DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0e-6_kind_phys + DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0e-6_kind_phys + DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0e-6_kind_phys + WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8_kind_phys SIGW_GW (I,k) = wparc_gw(k) * wparc_gw(k) SIGW_CNV (I,k) = wparc_cgw(k) * wparc_cgw(k) SIGW_TURB (I,k) = wparc_turb(k) * wparc_turb(k) @@ -1121,7 +1122,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do k=1,lm do i=1,im - if (CNV_MFD(i,k) > 1.0d-6) then + if (CNV_MFD(i,k) > 1.0e-6_kind_phys) then tx1 = one / CNV_MFD(i,k) CNV_NDROP(i,k) = CNV_NDROP(i,k) * tx1 CNV_NICE(i,k) = CNV_NICE(i,k) * tx1 @@ -1230,7 +1231,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=1,10 do k=1,lm naconr8(k,l) = zero - rndstr8(k,l) = 2.0d-7 + rndstr8(k,l) = 2.0e-7_kind_phys enddo enddo do k=1,lm @@ -1241,7 +1242,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! tx1 = MIN(CLLS(I,k) + CLCN(I,k), 0.99) tx1 = MIN(CLLS(I,k) + CLCN(I,k), one) if (tx1 > zero) then - cldfr8(k) = min(max(tx1, 0.00001d0), one) + cldfr8(k) = min(max(tx1, 0.00001_kind_phys), one) else cldfr8(k) = zero endif @@ -1277,7 +1278,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & naair8(k) = INC_NUC(I,k) npccninr8(k) = CDNC_NUC(I,k) - if (cldfr8(k) >= 0.001d0) then + if (cldfr8(k) >= 0.001_kind_phys) then nimmr8(k) = min(DNHET_IMM(I,k),ncr8(k)/(cldfr8(k)*DT_MOIST)) else nimmr8(k) = zero @@ -1305,11 +1306,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! naux = AeroAux_b%nmods ! rnsootr8 (K) = sum(AeroAux_b%dpg(1:naux))/naux - pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0d0 + pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0_kind_phys rpdelr8(k) = one / pdelr8(k) - plevr8(k) = 100.0d0 * PLO(I,k) + plevr8(k) = 100.0_kind_phys * PLO(I,k) zmr8(k) = ZLO(I,k) - ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0d-10) + ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0e-10_kind_phys) omegr8(k) = WSUB(I,k) ! alphar8(k) = max(alpht_x(i,k)/maxval(alpht_x(i,:))*8.,0.5) ! alphar8(k) = qcvar2 @@ -1317,7 +1318,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO do k=1,lm+1 - pintr8(k) = PLE(I,k-1) * 100.0d0 + pintr8(k) = PLE(I,k-1) * 100.0_kind_phys kkvhr8(k) = KH(I,k-1) END DO @@ -1402,8 +1403,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if (lprint) write(0,*)' prectr8=',prectr8(1), & ! & ' precir8=',precir8(1) - LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0d0*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) do k=1,lm @@ -1421,10 +1422,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPR(I,k) = nrr8(k) NCPS(I,k) = nsr8(k) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0), 150.0d0) - CLDREFFI(I,k) = min(max(effir8(k), 20.0d0), 150.0d0) - CLDREFFR(I,k) = max(droutr8(k)*0.5d0*1.0d6, 150.0d0) - CLDREFFS(I,k) = max(0.192d0*dsoutr8(k)*0.5d0*1.0d6, 250.0d0) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) + CLDREFFR(I,k) = max(droutr8(k)*0.5_kind_phys*1.0e6_kind_phys, 150.0_kind_phys) + CLDREFFS(I,k) = max(0.192_kind_phys*dsoutr8(k)*0.5_kind_phys*1.0e6_kind_phys, 250.0_kind_phys) enddo ! K loop @@ -1506,8 +1507,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0d0*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1521,10 +1522,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) - CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) - CLDREFFR(I,k) = max(reff_rain(k),150.0d0) - CLDREFFS(I,k) = max(reff_snow(k),250.0d0) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) + CLDREFFR(I,k) = max(reff_rain(k), 150.0_kind_phys) + CLDREFFS(I,k) = max(reff_snow(k), 250.0_kind_phys) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1535,10 +1536,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0d0 - CLDREFFI(I,k) = 50.0d0 - CLDREFFR(I,k) = 1000.0d0 - CLDREFFS(I,k) = 250.0d0 + CLDREFFL(I,k) = 10.0_kind_phys + CLDREFFI(I,k) = 50.0_kind_phys + CLDREFFR(I,k) = 1000.0_kind_phys + CLDREFFS(I,k) = 250.0_kind_phys enddo ! K loop endif ! @@ -1643,8 +1644,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) - LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0d0*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1660,11 +1661,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) - CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) - CLDREFFR(I,k) = max(reff_rain(k),150.0d0) - CLDREFFS(I,k) = max(reff_snow(k),250.0d0) - CLDREFFG(I,k) = max(reff_grau(k),250.0d0) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) + CLDREFFR(I,k) = max(reff_rain(k),150.0_kind_phys) + CLDREFFS(I,k) = max(reff_snow(k),250.0_kind_phys) + CLDREFFG(I,k) = max(reff_grau(k),250.0_kind_phys) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1675,11 +1676,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0d0 - CLDREFFI(I,k) = 50.0d0 - CLDREFFR(I,k) = 1000.0d0 - CLDREFFS(I,k) = 250.0d0 - CLDREFFG(I,k) = 250.0d0 + CLDREFFL(I,k) = 10.0_kind_phys + CLDREFFI(I,k) = 50.0_kind_phys + CLDREFFR(I,k) = 1000.0_kind_phys + CLDREFFS(I,k) = 250.0_kind_phys + CLDREFFG(I,k) = 250.0_kind_phys enddo ! K loop endif endif @@ -1707,17 +1708,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif enddo enddo @@ -1747,17 +1748,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) endif enddo enddo @@ -1849,7 +1850,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) - rn_o(i) = tx1 * dt_i * 0.001d0 + rn_o(i) = tx1 * dt_i * 0.001_kind_phys if (rn_o(i) < rainmin) then sr_o(i) = zero diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 6164cf544..636293b86 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -324,7 +324,7 @@ subroutine micro_mg_init( & !----------------------------------------------------------------------- - dcs = micro_mg_dcs * 1.0e-6 + dcs = micro_mg_dcs * 1.0e-6_r8 ts_au_min = ts_auto(1) ts_au = ts_auto(2) qcvar = mg_qcvar @@ -613,7 +613,6 @@ subroutine micro_mg_tend ( & integer, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics - ! used for scavenging ! Inputs for aerosol activation real(r8), intent(inout) :: naai(mgncol,nlev) !< ice nucleation number (from microp_aero_ts) (1/kg) @@ -1091,7 +1090,7 @@ subroutine micro_mg_tend ( & ! logical, parameter :: do_ice_gmao=.true., do_liq_liu=.false. ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & - real(r8), parameter :: qimax=0.010, qimin=0.005, qiinv=one/(qimax-qimin) + real(r8), parameter :: qimax=0.010_r8, qimin=0.005_r8, qiinv=one/(qimax-qimin) ! ts_au_min=180.0 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -3194,9 +3193,9 @@ subroutine micro_mg_tend ( & !++ag Add graupel dumg(i,k) = (qg(i,k)+qgtend(i,k)*deltat) * tx1 ! Moorthi testing - if (dumg(i,k) > 0.01) then - tx2 = dumg(i,k) - 0.01 - dumg(i,k) = 0.01 + if (dumg(i,k) > 0.01_r8) then + tx2 = dumg(i,k) - 0.01_r8 + dumg(i,k) = 0.01_r8 dums(i,k) = dums(i,k) + tx2 qstend(i,k) = (dums(i,k)*precip_frac(i,k) - qs(i,k)) * oneodt qgtend(i,k) = (dumg(i,k)*precip_frac(i,k) - qg(i,k)) * oneodt @@ -3798,9 +3797,9 @@ subroutine micro_mg_tend ( & !++ag dumg(i,k) = max(qg(i,k)+qgtend(i,k)*deltat, zero) ! Moorthi testing - if (dumg(i,k) > 0.01) then - tx2 = dumg(i,k) - 0.01 - dumg(i,k) = 0.01 + if (dumg(i,k) > 0.01_r8) then + tx2 = dumg(i,k) - 0.01_r8 + dumg(i,k) = 0.01_r8 dums(i,k) = dums(i,k) + tx2 qstend(i,k) = (dums(i,k) - qs(i,k)) * oneodt qgtend(i,k) = (dumg(i,k) - qg(i,k)) * oneodt @@ -4049,7 +4048,7 @@ subroutine micro_mg_tend ( & ! qvn = epsqs*esn/(p(i,k)-omeps*esn) - if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then + if (qtmp > qvn .and. qvn > zero .and. allow_sed_supersat) then ! expression below is approximate since there may be ice deposition dum = (qtmp-qvn)/(one+xxlv_squared*qvn/(cpp*rv*ttmp*ttmp)) * oneodt ! add to output cme diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 5bdf0ceef..4afe19dec 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -71,6 +71,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! locals ! + integer, parameter :: r8 = kind_phys integer i,is,k,kk,km1,kmpbl,kp1, ntloc ! logical pblflg(im), sfcflg(im), flg(im) @@ -91,15 +92,16 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, ttend, utend, vtend, qtend &, spdk2, rbint, ri, zol1, robn, bvf2 ! - real(kind=kind_phys), parameter :: one=1.0d0, zero=0.0d0 - &, zolcr=0.2d0, - & zolcru=-0.5d0, rimin=-100.0d0, sfcfrac=0.1d0, - & crbcon=0.25d0, crbmin=0.15d0, crbmax=0.35d0, - & qmin=1.0d-8, zfmin=1.0d-8, qlmin=1.0d-12, - & aphi5=5.0d0, aphi16=16.0d0, f0=1.0d-4 - &, dkmin=zero, dkmax=1000.0d0 -! &, dkmin=zero, dkmax=1000., xkzminv=0.3 - &, prmin=0.25d0, prmax=4.0d0, vk=0.4, cfac=6.5 + real(kind=kind_phys), parameter :: one=1.0_r8, zero=0.0_r8 + &, zolcr=0.2_r8, + & zolcru=-0.5_r8, rimin=-100.0_r8, sfcfrac=0.1_r8, + & crbcon=0.25_r8, crbmin=0.15_r8, crbmax=0.35_r8, + & qmin=1.0e-8_r8, zfmin=1.0d-8, qlmin=1.0e-12_r8, + & aphi5=5.0_r8, aphi16=16.0_r8, f0=1.0e-4_r8 + &, dkmin=zero, dkmax=1000.0_r8 +! &, dkmin=zero, dkmax=1000., xkzminv=0.3 + &, prmin=0.25_r8, prmax=4.0_r8, vk=0.4_r8, + & cfac=6.5_r8 real(kind=kind_phys) :: gravi, cont, conq, conw, gocp gravi = one/grav @@ -155,7 +157,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (k <= kinver(i)) then ! vertical background diffusivity for heat and momentum tem1 = one - prsi(i,k+1) * tx1(i) - tem1 = min(one, exp(-tem1 * tem1 * 10.0d0)) + tem1 = min(one, exp(-tem1 * tem1 * 10.0_r8)) xkzo(i,k) = xkzm_h * tem1 xkzmo(i,k) = xkzm_m * tem1 endif @@ -166,9 +168,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,kmpbl do i=1,im - if(zi(i,k+1) > 250.0d0) then + if(zi(i,k+1) > 250.0_r8) then tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.0d-5) then + if(tem1 > 1.0e-5_r8) then xkzo(i,k) = min(xkzo(i,k),xkzminv) endif endif @@ -177,7 +179,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! do i = 1,im - z0(i) = 0.01d0 * zorl(i) + z0(i) = 0.01_r8 * zorl(i) kpbl(i) = 1 hpbl(i) = zi(i,1) pblflg(i) = .true. @@ -224,9 +226,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, thermal(i) = tsea(i)*(one+fv*max(q1(i,1,1),qmin)) tem = max(one, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) robn = tem / (f0 * z0(i)) - tem1 = 1.0d-7 * robn - crb(i) = max(min(0.16d0 * (tem1 ** (-0.18d0)), crbmax), - & crbmin) + tem1 = 1.0e-7_r8 * robn + crb(i) = max(min(0.16_r8 * (tem1 ** (-0.18_r8)), crbmax), + & crbmin) endif enddo do k = 1, kmpbl @@ -272,7 +274,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if(sfcflg(i)) then ! phim(i) = (1.-aphi16*zol1)**(-1./4.) ! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = one / max(one - aphi16*zol1, 1.0d-8) + tem = one / max(one - aphi16*zol1, 1.0e-8_r8) phih(i) = sqrt(tem) phim(i) = sqrt(phih(i)) else @@ -346,13 +348,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, tem = u1(i,k) - u1(i,kp1) tem1 = v1(i,k) - v1(i,kp1) tem = (tem*tem + tem1*tem1) * rdz * rdz - bvf2 = (0.5d0*grav)*(thvx(i,kp1)-thvx(i,k))*rdz + bvf2 = (0.5_r8*grav)*(thvx(i,kp1)-thvx(i,k))*rdz & / (t1(i,k)+t1(i,kp1)) ri = max(bvf2/tem,rimin) if(ri < zero) then ! unstable regime prnum(i,kp1) = one else - prnum(i,kp1) = min(one + 2.1d0*ri, prmax) + prnum(i,kp1) = min(one + 2.1_r8*ri, prmax) endif elseif (k > 1) then prnum(i,kp1) = prnum(i,1) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index f52b6d829..5d8e19643 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -194,16 +194,18 @@ subroutine lsm_noah_run & implicit none ! --- constant parameters: - real(kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 - real(kind=kind_phys), parameter :: rhoh2o = 1000.0d0 - real(kind=kind_phys), parameter :: a2 = 17.2693882d0 - real(kind=kind_phys), parameter :: a3 = 273.16d0 - real(kind=kind_phys), parameter :: a4 = 35.86d0 + 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 :: rhoh2o = 1000.0_kind_phys + real(kind=kind_phys), parameter :: a2 = 17.2693882_kind_phys + real(kind=kind_phys), parameter :: a3 = 273.16_kind_phys + real(kind=kind_phys), parameter :: a4 = 35.86_kind_phys real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) - real(kind=kind_phys), parameter :: qmin = 1.0d-8 + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys real(kind=kind_phys), save :: zsoil_noah(4) - data zsoil_noah / -0.1d0, -0.4d0, -1.0d0, -2.0d0 / + data zsoil_noah / -0.1_kind_phys, -0.4_kind_phys, & + & -1.0_kind_phys, -2.0_kind_phys / ! --- input: integer, intent(in) :: im, km, isot, ivegsrc @@ -445,8 +447,8 @@ subroutine lsm_noah_run & ! cm - surface exchange coefficient for momentum (\f$m s^{-1}\f$) -> cmx ! z0 - surface roughness (\f$m\f$) -> zorl(\f$cm\f$) - cmc = canopy(i) * 0.001d0 ! convert from mm to m - tsea = tsurf(i) ! clu_q2m_iter + cmc = canopy(i) * 0.001_kind_phys ! convert from mm to m + tsea = tsurf(i) ! clu_q2m_iter do k = 1, km stsoil(k) = stc(i,k) @@ -454,10 +456,10 @@ subroutine lsm_noah_run & slsoil(k) = slc(i,k) enddo - snowh = snwdph(i) * 0.001d0 ! convert from mm to m - sneqv = weasd(i) * 0.001d0 ! convert from mm to m + snowh = snwdph(i) * 0.001_kind_phys ! convert from mm to m + sneqv = weasd(i) * 0.001_kind_phys ! convert from mm to m if (sneqv /= zero .and. snowh == zero) then - snowh = 10.0d0 * sneqv + snowh = 10.0_kind_phys * sneqv endif chx = ch(i) * wind(i) ! compute conductance @@ -466,7 +468,7 @@ subroutine lsm_noah_run & cmm(i) = cmx ! ---- ... outside sflx, roughness uses cm as unit - z0 = zorl(i) * 0.01d0 + z0 = zorl(i) * 0.01_kind_phys ! ---- mgehne, sfc-perts ! - Apply perturbation of soil type b parameter and leave area index. bexpp = bexppert(i) ! sfc perts, mgehne @@ -511,7 +513,7 @@ subroutine lsm_noah_run & trans(i) = ett sbsno(i) = esnow snowc(i) = sncovr - stm(i) = soilm * 1000.0d0 ! unit conversion (from m to kg m-2) + stm(i) = soilm * 1000.0_kind_phys ! unit conversion (from m to kg m-2) snohf(i) = flx1 + flx2 + flx3 smcwlt2(i) = smcwlt @@ -528,17 +530,17 @@ subroutine lsm_noah_run & wet1(i) = smsoil(1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) ! --- ... unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) - runoff(i) = runoff1 * 1000.0d0 - drain (i) = runoff2 * 1000.0d0 + runoff(i) = runoff1 * 1000.0_kind_phys + drain (i) = runoff2 * 1000.0_kind_phys ! --- ... unit conversion (from m to mm) - canopy(i) = cmc * 1000.0d0 - snwdph(i) = snowh * 1000.0d0 - weasd(i) = sneqv * 1000.0d0 + canopy(i) = cmc * 1000.0_kind_phys + snwdph(i) = snowh * 1000.0_kind_phys + weasd(i) = sneqv * 1000.0_kind_phys sncovr1(i) = sncovr ! ---- ... outside sflx, roughness uses cm as unit (update after snow's ! effect) - zorl(i) = z0*100.0d0 + zorl(i) = z0*100.0_kind_phys !> - Do not return the following output fields to parent model: !!\n ec - canopy water evaporation (m s-1) diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index ba0aec030..d937ddf49 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -91,8 +91,8 @@ subroutine sfc_ocean_run & implicit none ! --- constant parameters: - real (kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 & - &, qmin = 1.0d-8 + real (kind=kind_phys), parameter :: one = 1.0_kind_phys, zero = 0.0_kind_phys & + &, qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im real (kind=kind_phys), intent(in) :: rd, eps, epsm1, rvrdm1 diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index db483ee75..8648e631b 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -138,15 +138,15 @@ subroutine sfc_sice_run & implicit none ! ! - Define constant parameters - integer, parameter :: kmi = 2 !< 2-layer of ice - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 - real(kind=kind_phys), parameter :: himax = 8.0d0 !< maximum ice thickness allowed - real(kind=kind_phys), parameter :: himin = 0.1d0 !< minimum ice thickness required - real(kind=kind_phys), parameter :: hsmax = 2.0d0 !< maximum snow depth allowed - real(kind=kind_phys), parameter :: timin = 173.0d0 !< minimum temperature allowed for snow/ice - real(kind=kind_phys), parameter :: albfw = 0.06d0 !< albedo for lead - real(kind=kind_phys), parameter :: dsi = one/0.33d0 - real(kind=kind_phys), parameter :: qmin = 1.0d-8 + integer, parameter :: kmi = 2 !< 2-layer of ice + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, 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 + real(kind=kind_phys), parameter :: dsi = one/0.33_kind_phys + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im, km, ipr @@ -232,7 +232,7 @@ subroutine sfc_sice_run & if (flag(i)) then if (srflag(i) > zero) then ep(i) = ep(i)*(one-srflag(i)) - weasd(i) = weasd(i) + 1.0d3*tprcp(i)*srflag(i) + weasd(i) = weasd(i) + 1000.0_kind_phys*tprcp(i)*srflag(i) tprcp(i) = tprcp(i)*(one-srflag(i)) endif endif @@ -289,7 +289,7 @@ subroutine sfc_sice_run & !> - Convert snow depth in water equivalent from mm to m unit. - snowd(i) = weasd(i) * 0.001d0 + snowd(i) = weasd(i) * 0.001_kind_phys ! flagsnw(i) = .false. ! --- ... when snow depth is less than 1 mm, a patchy snow is assumed and @@ -310,7 +310,8 @@ subroutine sfc_sice_run & ! evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) snetw(i) = sfcdsw(i) * (one - albfw) - snetw(i) = min(3.0d0*sfcnsw(i)/(one+2.0d0*ffw(i)), snetw(i)) + snetw(i) = min(3.0_kind_phys*sfcnsw(i) & + & / (one+2.0_kind_phys*ffw(i)), snetw(i)) !> - Calculate net solar incoming at top \a sneti. sneti(i) = (sfcnsw(i) - ffw(i)*snetw(i)) / fice(i) @@ -327,7 +328,7 @@ subroutine sfc_sice_run & & + rch(i)*(tice(i) - theta1(i)) #endif !> - Calculate heat flux derivative at surface \a hfd. - hfd(i) = 4.0d0*sfcemis(i)*sbc*tice(i)*t12 & + hfd(i) = 4.0_kind_phys*sfcemis(i)*sbc*tice(i)*t12 & & + (one + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) t12 = tgice * tgice @@ -340,14 +341,14 @@ subroutine sfc_sice_run & !> - Assigin heat flux from ocean \a focn and snowfall rate as constants, which !! should be from ocean model and other physics. - focn(i) = 2.0d0 ! heat flux from ocean - should be from ocn model + focn(i) = 2.0_kind_phys ! heat flux from ocean - should be from ocn model snof(i) = zero ! snowfall rate - snow accumulates in gbphys !> - Initialize snow depth \a snowd. hice(i) = max( min( hice(i), himax ), himin ) snowd(i) = min( snowd(i), hsmax ) - if (snowd(i) > (2.0d0*hice(i))) then + if (snowd(i) > (2.0_kind_phys*hice(i))) then print *, 'warning: too much snow :',snowd(i) snowd(i) = hice(i) + hice(i) print *,'fix: decrease snow depth to:',snowd(i) @@ -417,7 +418,7 @@ subroutine sfc_sice_run & ! --- ... convert snow depth back to mm of water equivalent - weasd(i) = snowd(i) * 1000.0d0 + weasd(i) = snowd(i) * 1000.0_kind_phys snwdph(i) = weasd(i) * dsi ! snow depth in mm tem = one / rho(i) @@ -520,28 +521,28 @@ subroutine ice3lay ! ! --- constant parameters: (properties of ice, snow, and seawater) - real (kind=kind_phys), parameter :: ds = 330.0d0 !< snow (ov sea ice) density (kg/m^3) - real (kind=kind_phys), parameter :: dw =1000.0d0 !< fresh water density (kg/m^3) + 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) real (kind=kind_phys), parameter :: dsdw = ds/dw real (kind=kind_phys), parameter :: dwds = dw/ds - real (kind=kind_phys), parameter :: ks = 0.31d0 !< conductivity of snow (w/mk) - real (kind=kind_phys), parameter :: i0 = 0.3d0 !< ice surface penetrating solar fraction - real (kind=kind_phys), parameter :: ki = 2.03d0 !< conductivity of ice (w/mk) - real (kind=kind_phys), parameter :: di = 917.0d0 !< density of ice (kg/m^3) + 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) real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di - real (kind=kind_phys), parameter :: ci = 2054.0d0 !< heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34d5 !< latent heat of fusion (j/kg-ice) - real (kind=kind_phys), parameter :: si = 1.0d0 !< salinity of sea ice - real (kind=kind_phys), parameter :: mu = 0.054d0 !< 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.8d0 !< tfw - seawater freezing temp (c) - real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001d0 + 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) + 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 real (kind=kind_phys), parameter :: dsli = ds*li - real (kind=kind_phys), parameter :: ki4 = ki*4.0d0 - real (kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + real (kind=kind_phys), parameter :: ki4 = ki*4.0_kind_phys + real (kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys ! --- inputs: integer, intent(in) :: im, kmi, ipr @@ -631,7 +632,7 @@ subroutine ice3lay !> - Calculate the new upper ice temperature following \a eq.(21) !! in Winton (2000) \cite winton_2000. - stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1-4.0_kind_phys*a1*c1) + b1)/(a1+a1) tice(i) = (k12*stsice(i,1) - ai) / (k12 + bi) !> - If the surface temperature is greater than the freezing temperature @@ -644,7 +645,8 @@ subroutine ice3lay if (tice(i) > tsf) then a1 = a10 + k12 b1 = b10 - k12*tsf - stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1-4.0_kind_phys*a1*c1) + b1) & + & / (a1+a1) tice(i) = tsf tmelt = (k12*(stsice(i,1)-tsf) - (ai+bi*tsf)) * delt else @@ -664,8 +666,8 @@ subroutine ice3lay !> - Calculation of ice and snow mass changes. - h1 = 0.5d0 * hice(i) - h2 = 0.5d0 * hice(i) + h1 = 0.5_kind_phys * hice(i) + h2 = 0.5_kind_phys * hice(i) !> - Calculate the top layer thickness. @@ -697,7 +699,7 @@ subroutine ice3lay hice(i) = h1 + h2 if (hice(i) > zero) then - if (h1 > 0.5d0*hice(i)) then + if (h1 > 0.5_kind_phys*hice(i)) then f1 = one - (h2+h2) / hice(i) stsice(i,2) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& & + (one - f1)*stsice(i,2) @@ -711,7 +713,7 @@ subroutine ice3lay stsice(i,1) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& & + (one - f1)*stsice(i,2) stsice(i,1) = (stsice(i,1) - sqrt(stsice(i,1)*stsice(i,1) & - & - 4.0d0*tfi*li/ci)) * 0.5d0 + & - 4.0_kind_phys*tfi*li/ci)) * 0.5_kind_phys endif k12 = ki4*ks / (ks*hice(i) + ki4*snowd(i)) From e19953d0da2ccd4b65bc4ac68a2cc09807805474 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Apr 2020 17:45:31 +0000 Subject: [PATCH 12/97] adding _kind_phys to constants in some physics routines --- physics/rascnv.F90 | 401 +++++++++++++++++++++++---------------------- 1 file changed, 201 insertions(+), 200 deletions(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 40d0ecb0d..c6601a5cb 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -10,37 +10,38 @@ module rascnv private logical :: is_initialized = .False. ! + integer, parameter :: r8 = kind_phys integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 - real (kind=kind_phys), parameter :: delt_c=1800.0d0/3600.0d0 & + real (kind=kind_phys), parameter :: delt_c=1800.0_r8/3600.0_r8 & ! Adjustment time scales in hrs for deep and shallow clouds ! &, adjts_d=3.0, adjts_s=0.5 ! &, adjts_d=2.5, adjts_s=0.5 - &, adjts_d=2.0d0, adjts_s=0.5d0 + &, adjts_d=2.0_r8, adjts_s=0.5_r8 ! logical, parameter :: fix_ncld_hr=.true. ! - real (kind=kind_phys), parameter :: ZERO=0.0d0, HALF=0.5d0 & - &, pt25=0.25d0, ONE=1.0d0 & - &, TWO=2.0d0, FOUR=4.0d0 & - &, twoo3=two/3.0d0 & - &, FOUR_P2=4.0d2, ONE_M10=1.0d-10& - &, ONE_M6=1.0d-6, ONE_M5=1.0d-5 & - &, ONE_M2=1.0d-2, ONE_M1=1.0d-1 & - &, oneolog10=one/log(10.0d0) & - &, facmb = 0.01d0 & ! conversion factor from Pa to hPa (or mb) - &, cmb2pa = 100.0d0 ! Conversion from hPa to Pa -! - real(kind=kind_phys), parameter :: frac=0.5d0, crtmsf=0.0d0 & - &, rhfacs=0.75d0, rhfacl=0.75d0 & - &, face=5.0d0, delx=10000.0d0 & - &, ddfac=face*delx*0.001d0 & - &, max_neg_bouy=0.15d0 & -! &, max_neg_bouy=pt25d0 & - &, testmb=0.1, testmbi=one/testmb & - &, dpd=0.5d0, rknob=1.0d0, eknob=1.0d0 + real (kind=kind_phys), parameter :: ZERO=0.0_r8, HALF=0.5_r8 & + &, pt25=0.25_r8, ONE=1.0_r8 & + &, TWO=2.0_r8, FOUR=4.0_r8 & + &, twoo3=two/3.0_r8 & + &, FOUR_P2=4.0e2_r8, ONE_M10=1.0e-10_r8& + &, ONE_M6=1.0e-6_r8, ONE_M5=1.0e-5_r8 & + &, ONE_M2=1.0e-2_r8, ONE_M1=1.0e-1_r8 & + &, oneolog10=one/log(10.0_r8) & + &, facmb = 0.01_r8 & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa = 100.0_r8 ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: frac=0.5_r8, crtmsf=0.0_r8 & + &, rhfacs=0.75_r8, rhfacl=0.75_r8 & + &, face=5.0_r8, delx=10000.0_r8& + &, ddfac=face*delx*0.001_r8 & + &, max_neg_bouy=0.15_r8 & +! &, max_neg_bouy=pt25_r8 & + &, testmb=0.1_r8, testmbi=one/testmb & + &, dpd=0.5_r8, rknob=1.0_r8, eknob=1.0_r8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! logical, parameter :: do_aw=.true., cumfrc=.true. & @@ -52,17 +53,17 @@ module rascnv ! &, advcld=.true., advups=.false.,advtvd=.false. - real(kind=kind_phys), parameter :: TF=233.16d0, TCR=273.16d0 & - &, TCRF=one/(TCR-TF), TCL=2.0d0 + real(kind=kind_phys), parameter :: TF=233.16_r8, TCR=273.16_r8 & + &, TCRF=one/(TCR-TF), TCL=2.0_r8 ! ! For pressure gradient force in momentum mixing -! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & +! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & ! No pressure gradient force in momentum mixing - real (kind=kind_phys), parameter :: pgftop=0.0d0, pgfbot=0.0d0 & -! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & - &, pgfgrad=(pgfbot-pgftop)*0.001d0& - &, cfmax=0.1d0 + real (kind=kind_phys), parameter :: pgftop=0.0_r8, pgfbot=0.0_r8 & +! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & + &, pgfgrad=(pgfbot-pgftop)*0.001_r8& + &, cfmax=0.1_r8 ! ! For Tilting Angle Specification ! @@ -120,7 +121,7 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! - real(kind=kind_phys), parameter :: actp=1.7, facm=1.00 + real(kind=kind_phys), parameter :: actp=1.7_r8, facm=1.00_r8 ! real(kind=kind_phys) PH(15), A(15) ! @@ -167,7 +168,7 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & ! ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! - AFC = -(1.01097d-4*DT)*(3600.0d0/DT)**0.57777778d0 + AFC = -(1.01097e-4_r8*DT)*(3600.0_r8/DT)**0.57777778_r8 ! grav = con_g ; cp = con_cp ; alhl = con_hvap alhf = con_hfus ; rgas = con_rd @@ -179,15 +180,15 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & pi = four*atan(one) ; PIINV = one/PI ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA - rkap = rgas * onebcp ; deg2rad = pi/180.d0 + rkap = rgas * onebcp ; deg2rad = pi/180.0_r8 ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS - picon = half*pi*onebg ; zfac = 0.28888889d-4 * ONEBG + picon = half*pi*onebg ; zfac = 0.28888889e-4_r8 * ONEBG testmboalhl = testmb/alhl ! - rvi = one/rv ; facw=CVAP-CLIQ - faci = CVAP-CSOL ; hsub=alhl+alhf - tmix = TTP-20.0d0 ; DEN=one/(TTP-TMIX) + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0_r8 ; DEN=one/(TTP-TMIX) ! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & @@ -365,7 +366,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & integer, dimension(100) :: ic - real(kind=kind_phys), parameter :: clwmin=1.0d-10 + real(kind=kind_phys), parameter :: clwmin=1.0e-10_r8 ! real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & &, trcfac(:,:), rcu(:,:) @@ -392,8 +393,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & fscav_(i) = fscav(i) enddo endif - trcmin = -99999.0 - if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 + trcmin = -99999.0_r8 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_r8 !> - Initialize CCPP error handling variables @@ -487,23 +488,23 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (flipv) ll = kp1 -l ! Input variables are bottom to top! SGC = prsl(ipt,ll) * tem sgcs(l,ipt) = sgc - IF (SGC <= 0.050d0) KRMIN = L -! IF (SGC <= 0.700d0) KRMAX = L -! IF (SGC <= 0.800d0) KRMAX = L - IF (SGC <= 0.760d0) KRMAX = L -! IF (SGC <= 0.930d0) KFMAX = L - IF (SGC <= 0.970d0) KFMAX = L ! Commented on 20060202 -! IF (SGC <= 0.700d0) kblmx = L ! Commented on 20101015 - IF (SGC <= 0.600d0) kblmx = L ! -! IF (SGC <= 0.650d0) kblmx = L ! Commented on 20060202 - IF (SGC <= 0.980d0) kblmn = L ! + IF (SGC <= 0.050_r8) KRMIN = L +! IF (SGC <= 0.700_r8) KRMAX = L +! IF (SGC <= 0.800_r8) KRMAX = L + IF (SGC <= 0.760_r8) KRMAX = L +! IF (SGC <= 0.930_r8) KFMAX = L + IF (SGC <= 0.970_r8) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700_r8) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600_r8) kblmx = L ! +! IF (SGC <= 0.650_r8) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980_r8) kblmn = L ! ENDDO krmin = max(krmin,2) ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 - NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001d0 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001_r8 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 @@ -513,7 +514,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & facdt = delt_c / dt else NCRND = min(nrcmax, (KRMAX-KRMIN+1)) - facdt = one / 3600.0d0 + facdt = one / 3600.0_r8 endif NCRND = min(nrcm,max(NCRND, 1)) ! @@ -537,7 +538,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & IF (NCRND > 0) THEN DO I=1,NCRND II = mod(i-1,nrcm) + 1 - IRND = (RANNUM(ipt,II)-0.0005d0)*(KCR-KRMIN+1) + IRND = (RANNUM(ipt,II)-0.0005_r8)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF @@ -582,7 +583,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,ll,n+2) - if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0e-20_r8) uvi(l,n) = zero enddo endif enddo @@ -593,7 +594,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & phi_h(LL) = phii(ipt,L) enddo ! - if (ccin(ipt,1,2) <= -998.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0_r8) then ! input ice/water are together do l=1,k ll = kp1 -l tem = ccin(ipt,ll,1) & @@ -631,7 +632,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,l,n+2) - if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0e-20_r8) uvi(l,n) = zero enddo endif enddo @@ -641,7 +642,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & phi_h(L) = phii(ipt,L) ENDDO ! - if (ccin(ipt,1,2) <= -998.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0_r8) then ! input ice/water are together do l=1,k tem = ccin(ipt,l,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) @@ -688,7 +689,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd=',dtvd(:,1) - if (abs(dtvd(2,1)) > 1.0d-10) then + if (abs(dtvd(2,1)) > 1.0e-10_r8) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h @@ -702,7 +703,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) - if (abs(dtvd(2,2)) > 1.0d-10) then + if (abs(dtvd(2,2)) > 1.0e-10_r8) then tem1 = dtvd(1,2) / dtvd(2,2) tem2 = abs(tem1) alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q @@ -713,7 +714,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) - if (abs(dtvd(2,3)) > 1.0d-10) then + if (abs(dtvd(2,3)) > 1.0e-10_r8) then tem1 = dtvd(1,3) / dtvd(2,3) tem2 = abs(tem1) alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql @@ -724,7 +725,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) - if (abs(dtvd(2,4)) > 1.0d-10) then + if (abs(dtvd(2,4)) > 1.0e-10_r8) then tem1 = dtvd(1,4) / dtvd(2,4) tem2 = abs(tem1) alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi @@ -741,7 +742,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l - if (abs(dtvd(2,1)) > 1.0d-10) then + if (abs(dtvd(2,1)) > 1.0e-10_r8) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers @@ -850,7 +851,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & FLXD(L) = zero enddo ! - TLA = -10.0d0 + TLA = -10.0_r8 ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection @@ -930,7 +931,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ENDDO ! End of the NC loop! ! - RAINC(ipt) = rain * 0.001d0 ! Output rain is in meters + RAINC(ipt) = rain * 0.001_r8 ! Output rain is in meters ktop(ipt) = kp1 kbot(ipt) = 0 @@ -944,9 +945,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! clw(i) = max(clw(i), zero) ! cli(i) = max(cli(i), zero) - if (sgcs(l,ipt) < 0.93d0 .and. abs(tcu(l)) > one_m10) then -! if (sgcs(l,ipt) < 0.90d0 .and. tcu(l) .ne. 0.0) then -! if (sgcs(l,ipt) < 0.85d0 .and. tcu(l) .ne. 0.0) then + if (sgcs(l,ipt) < 0.93_r8 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90_r8 .and. tcu(l) .ne. zero) then +! if (sgcs(l,ipt) < 0.85_r8 .and. tcu(l) .ne. zero) then kcnv(ipt) = 1 endif ! New test for convective clouds ! added in 08/21/96 @@ -972,18 +973,18 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) CNV_FICE(ipt,ll) = QICN(ipt,ll) & - & / max(1.d-10,QLCN(ipt,ll)+QICN(ipt,ll)) + & / max(1.0e-10_r8,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) QICN(ipt,ll) = qii(l) - CNV_FICE(ipt,ll) = qii(l)/max(1.d-10,qii(l)+qli(l)) + CNV_FICE(ipt,ll) = qii(l)/max(1.0e-10_r8,qii(l)+qli(l)) endif - cf_upi(ipt,ll) = max(zero,min(0.02d0*log(one+ & - & 500.0d0*ud_mf(ipt,ll)/dt), cfmax)) + cf_upi(ipt,ll) = max(zero,min(0.02_r8*log(one+ & + & 500.0_r8*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,ll),1.d-12)*prsl(ipt,ll)) + & (dt*max(cf_upi(ipt,ll),1.0e-12_r8)*prsl(ipt,ll)) endif if (ntr > 0) then @@ -1023,21 +1024,21 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) CNV_FICE(ipt,l) = QICN(ipt,l) & - & / max(1.d-10,QLCN(ipt,l)+QICN(ipt,l)) + & / max(1.0e-10_r8,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) QICN(ipt,l) = qii(l) - CNV_FICE(ipt,l) = qii(l)/max(1.d-10,qii(l)+qli(l)) + CNV_FICE(ipt,l) = qii(l)/max(1.0e-10_r8,qii(l)+qli(l)) endif !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02d0*log(one+ & - & 500.d0*ud_mf(ipt,l)/dt), cfmax)) + cf_upi(ipt,l) = max(zero,min(0.02_r8*log(one+ & + & 500.0_r8*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,l),1.d-12)*prsl(ipt,l)) + & (dt*max(cf_upi(ipt,l),1.0e-12_r8)*prsl(ipt,l)) endif if (ntr > 0) then @@ -1140,33 +1141,33 @@ SUBROUTINE CLOUD( & ! IMPLICIT NONE ! - real (kind=kind_phys), parameter :: RHMAX=1.0d0 & ! MAX RELATIVE HUMIDITY - &, QUAD_LAM=1.0d0 & ! MASK FOR QUADRATIC LAMBDA - &, RHRAM=0.05d0 & ! PBL RELATIVE HUMIDITY RAMP -! &, RHRAM=0.15d0 !& ! PBL RELATIVE HUMIDITY RAMP - &, HCRITD=4000.0d0 & ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0d0 & ! Critical Moist Static Energy for Shallow clouds - &, pcrit_lcl=250.0d0 & ! Critical pressure difference between boundary layer top + real (kind=kind_phys), parameter :: RHMAX=1.0_r8 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0_r8 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05_r8 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15_r8 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0_r8 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0_r8 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0_r8 & ! Critical pressure difference between boundary layer top ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01d0 !& ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005d0 !& ! Perturbation on hbl when ctei=.true. - &, qudfac=quad_lam*half & - &, shalfac=3.0d0 & -! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's - &, c0ifac=0.07d0 & ! following Han et al, 2016 MWR - &, dpnegcr = 150.0d0 -! &, dpnegcr = 100.0d0 -! &, dpnegcr = 200.0d0 -! - real(kind=kind_phys), parameter :: ERRMIN=0.0001d0 & - &, ERRMI2=0.1d0*ERRMIN & -! &, rainmin=1.0d-9 !& - &, rainmin=1.0d-8 & - &, oneopt9=1.0d0/0.09d0 & - &, oneopt4=1.0d0/0.04d0 - real(kind=kind_phys), parameter :: almax=1.0d-2 & - &, almin1=0.0d0, almin2=0.0d0 - real(kind=kind_phys), parameter :: bldmax=300.0d0, bldmin=25.0d0 +! &, hpert_fac=1.01_r8 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005_r8 !& ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half & + &, shalfac=3.0_r8 & +! &, qudfac=quad_lam*pt25, shalfac=3.0_r8 !& ! Yogesh's + &, c0ifac=0.07_r8 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0_r8 +! &, dpnegcr = 100.0_r8 +! &, dpnegcr = 200.0_r8 +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001_r8 & + &, ERRMI2=0.1_r8*ERRMIN & +! &, rainmin=1.0e-9_r8 !& + &, rainmin=1.0e-8_r8 & + &, oneopt9=one/0.09_r8 & + &, oneopt4=one/0.04_r8 + real(kind=kind_phys), parameter :: almax=1.0e-2_r8 & + &, almin1=0.0_r8, almin2=0.0_r8 + real(kind=kind_phys), parameter :: bldmax=300.0_r8, bldmin=25.0_r8 ! ! INPUT ARGUMENTS @@ -1371,13 +1372,13 @@ SUBROUTINE CLOUD( & ! To determine KBL internally -- If KBL is defined externally ! the following two loop should be skipped ! - if (sgcs(kd) < 0.5d0) then + if (sgcs(kd) < 0.5_r8) then hcrit = hcritd - elseif (sgcs(kd) > 0.65d0) then + elseif (sgcs(kd) > 0.65_r8) then hcrit = hcrits else - hcrit = (hcrits*(sgcs(kd)-0.5d0) + hcritd*(0.65d0-sgcs(kd)))& - & * (one/0.15d0) + hcrit = (hcrits*(sgcs(kd)-0.5_r8) + hcritd*(0.65_r8-sgcs(kd)))& + & * (one/0.15_r8) endif IF (CALKBL) THEN KTEM = MAX(KD+1, KBLMX) @@ -1461,7 +1462,7 @@ SUBROUTINE CLOUD( & ii = max(kbl,kd1) kbl = max(klcl,kd1) - tem = min(50.0d0,max(10.0d0,(prl(kmaxp1)-prl(kd))*0.10d0)) + tem = min(50.0_r8,max(10.0_r8,(prl(kmaxp1)-prl(kd))*0.10_r8)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii @@ -1521,7 +1522,7 @@ SUBROUTINE CLOUD( & ! shal_fac = one ! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac - if (prl(kbl)-prl(kd) < 350.0d0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0_r8 .and. kmax == k) shal_fac = shalfac DO L=Kmax,KD,-1 IF (L >= KBL) THEN ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM @@ -1583,7 +1584,7 @@ SUBROUTINE CLOUD( & endif enddo ! - if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0d0) & + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0_r8) & & return ! TX1 = RHFACS - QBL / TX1 ! Average RH @@ -1593,9 +1594,9 @@ SUBROUTINE CLOUD( & IF (.NOT. cnvflg) RETURN ! - RHC = MAX(ZERO, MIN(ONE, EXP(-20.0d0*TX1) )) + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0_r8*TX1) )) ! - wcbase = 0.1d0 + wcbase = 0.1_r8 if (ntrc > 0) then DO N=1,NTRC RBL(N) = ROI(Kmax,N) * ETA(Kmax) @@ -1752,13 +1753,13 @@ SUBROUTINE CLOUD( & HSU = HSU - ALM * TX3 ! CLP = ZERO - ALM = -100.0d0 + ALM = -100.0_r8 HOS = HOL(KD) QOS = QOL(KD) QIS = CIL(KD) QLS = CLL(KD) - cnvflg = HBL > HSU .and. abs(tx1) > 1.0d-4 + cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4_r8 !*********************************************************************** @@ -1775,7 +1776,7 @@ SUBROUTINE CLOUD( & if (tx2 == zero) then alm = - st2 / tx1 - if (alm > almax) alm = -100.0d0 + if (alm > almax) alm = -100.0_r8 else x00 = tx2 + tx2 epp = tx1 * tx1 - (x00+x00)*st2 @@ -1784,8 +1785,8 @@ SUBROUTINE CLOUD( & tem = sqrt(epp) tem1 = (-tx1-tem)*x00 tem2 = (-tx1+tem)*x00 - if (tem1 > almax) tem1 = -100.0d0 - if (tem2 > almax) tem2 = -100.0d0 + if (tem1 > almax) tem1 = -100.0_r8 + if (tem2 > almax) tem2 = -100.0_r8 alm = max(tem1,tem2) endif @@ -1856,12 +1857,12 @@ SUBROUTINE CLOUD( & ACR = zero TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF tx1 = PRL(KBL) - TEM - tx2 = min(900.0d0, max(tx1,100.0d0)) - tem1 = log(tx2*0.01d0) * oneolog10 + tx2 = min(900.0_r8, max(tx1,100.0_r8)) + tem1 = log(tx2*0.01_r8) * oneolog10 tem2 = one - tem1 if ( kdt == 1 ) then -! rel_fac = (dt * facdt) / (tem1*12.0d0 + tem2*3.0) - rel_fac = (dt * facdt) / (tem1*6.0d0 + tem2*adjts_s) +! rel_fac = (dt * facdt) / (tem1*12.0_r8 + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0_r8 + tem2*adjts_s) else rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) endif @@ -1870,7 +1871,7 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - iwk = tem*0.02d0 - 0.999999999d0 + iwk = tem*0.02_r8 - 0.999999999_r8 iwk = MAX(1, MIN(iwk, 16)) ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF ENDIF @@ -2043,7 +2044,7 @@ SUBROUTINE CLOUD( & ! CALCUP = .FALSE. - TEM = max(0.05d0, MIN(CD*200.0d0, MAX_NEG_BOUY)) + TEM = max(0.05_r8, MIN(CD*200.0_r8, MAX_NEG_BOUY)) IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. @@ -2086,7 +2087,7 @@ SUBROUTINE CLOUD( & ENDIF PL = (PRL(KD1) + PRL(KD))*HALF - IF (TRAIN > 1.0d-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + IF (TRAIN > 1.0e-4_r8 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) @@ -2401,7 +2402,7 @@ SUBROUTINE CLOUD( & ! sigf(kd) = max(zero, min(one, tx1 * tx1)) ! endif if (do_aw) then - tx1 = (0.2d0 / max(alm, 1.0d-5)) + tx1 = (0.2_r8 / max(alm, 1.0e-5_r8)) tx2 = one - min(one, pi * tx1 * tx1 / area) tx2 = tx2 * tx2 @@ -2525,8 +2526,8 @@ SUBROUTINE CLOUD( & endif enddo tem = tem + amb * dof * sigf(kbl) - tem = tem * (3600.0d0/dt) - tem1 = sqrt(max(one, min(100.0d0,(6.25d10/max(area,one))))) ! 20110530 + tem = tem * (3600.0_r8/dt) + tem1 = sqrt(max(one, min(100.0_r8,(6.25e10_r8/max(area,one))))) ! 20110530 clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) cldfrd = clfrac @@ -2573,7 +2574,7 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778d0 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778_r8 )) ACTEVAP = MIN(TX1, TEM4*CLFRAC) @@ -2581,7 +2582,7 @@ SUBROUTINE CLOUD( & ! tem4 = zero if (tx2 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778d0 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778_r8 )) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2650,7 +2651,7 @@ SUBROUTINE CLOUD( & ! following Liu et al. [JGR,2001] Eq 1 if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001d0) + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001_r8) FNOSCAV = exp(- FSCAV_(N) * DELZKM) else FNOSCAV = one @@ -2660,7 +2661,7 @@ SUBROUTINE CLOUD( & & * FNOSCAV DO L=KD1,K if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001d0) + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001_r8) FNOSCAV = exp(- FSCAV_(N) * DELZKM) endif lm1 = l - 1 @@ -2779,7 +2780,7 @@ SUBROUTINE DDRFT( & &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & &, IDW, IDH, IDN(K), idnm, itr ! - parameter (ERRMIN=0.0001d0, ERRMI2=0.1d0*ERRMIN) + parameter (ERRMIN=0.0001_r8, ERRMI2=0.1_r8*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! ! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi @@ -2789,9 +2790,9 @@ SUBROUTINE DDRFT( & ! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) ! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) ! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) - PARAMETER (AA1=1.0d0, BB1=1.0d0, CC1=1.0d0, DD1=1.0d0, & - & F3=CC1, F5=1.0d0) - parameter (QRMIN=1.0d-6, WC2MIN=0.01d0, GMF1=GMF/AA1, GMF5=GMF/F5) + PARAMETER (AA1=1.0_r8, BB1=1.0_r8, CC1=1.0_r8, DD1=1.0_r8, & + & F3=CC1, F5=1.0_r8) + parameter (QRMIN=1.0e-6_r8, WC2MIN=0.01_r8, GMF1=GMF/AA1, GMF5=GMF/F5) ! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) @@ -2800,12 +2801,12 @@ SUBROUTINE DDRFT( & &, itrmin=15, itrmnd=12, numtla=2 ! uncentering for vvel in dd - real(kind=kind_phys), parameter :: ddunc1=0.25d0 & + real(kind=kind_phys), parameter :: ddunc1=0.25_r8 & &, ddunc2=one-ddunc1 & ! &, ddunc1=0.4, ddunc2=one-ddunc1 & ! &, ddunc1=0.3, ddunc2=one-ddunc1 & - &, VTPEXP=-0.3636d0 & - &, VTP=36.34d0*SQRT(1.2d0)*(0.001d0)**0.1364d0 + &, VTPEXP=-0.3636_r8 & + &, VTP=36.34_r8*SQRT(1.2_r8)*(0.001_r8)**0.1364_r8 ! ! real(kind=kind_phys) EM(K*K), ELM(K) real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & @@ -2830,7 +2831,7 @@ SUBROUTINE DDRFT( & CLDFRD = zero RNTP = zero DOF = zero - ERRQ = 10.0d0 + ERRQ = 10.0_r8 RNB = zero RNT = zero TX2 = PRL(KBL) @@ -2861,7 +2862,7 @@ SUBROUTINE DDRFT( & ENDDO if (kk /= kbl) then do l=kk,kbl - buy(l) = 0.9d0 * buy(l-1) + buy(l) = 0.9_r8 * buy(l-1) enddo endif ! @@ -2869,24 +2870,24 @@ SUBROUTINE DDRFT( & qrpi(l) = buy(l) enddo do l=kd1,kb1 - buy(l) = 0.25d0 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + buy(l) = 0.25_r8 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) enddo ! ! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) - tx1 = 1000.0d0 + tx1 - prl(kp1) + tx1 = 1000.0_r8 + tx1 - prl(kp1) ! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) CALL ANGRAD(TX1, ALM, AL2, TLA) ! ! Following Ucla approach for rain profile ! - F2 = (BB1+BB1)*ONEBG/(PI*0.2d0) + F2 = (BB1+BB1)*ONEBG/(PI*0.2_r8) ! WCMIN = SQRT(WC2MIN) ! WCBASE = WCMIN ! ! del_tla = TLA * 0.2 ! del_tla = TLA * 0.25 - del_tla = TLA * 0.3d0 + del_tla = TLA * 0.3_r8 TLA = TLA - DEL_TLA ! DO L=KD,K @@ -2947,15 +2948,15 @@ SUBROUTINE DDRFT( & do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries ! ------ ! if (errq < 1.0 .or. tla > 45.0) cycle - if (errq < 0.1d0 .or. tla > 45.0d0) cycle + if (errq < 0.1_r8 .or. tla > 45.0_r8) cycle ! tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle ! - STLA = F2 * STLA * AL2 - CTL2 = DD1 * CTL2 - CTL3 = 0.1364d0 * CTL2 + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364_r8 * CTL2 ! DO L=KD,K RNF(L) = zero @@ -3018,8 +3019,8 @@ SUBROUTINE DDRFT( & VRW(1) = F3*WVL(KD) - CTL2*VT(1) BUD(KD) = STLA * TX6 * QRB(KD) * half RNF(KD) = BUD(KD) - DOF = 1.1364d0 * BUD(KD) * QRPI(KD) - DOFW = -BUD(KD) * STLT(KD) + DOF = 1.1364_r8 * BUD(KD) * QRPI(KD) + DOFW = -BUD(KD) * STLT(KD) ! RNT = TRW(1) * VRW(1) TX2 = zero @@ -3052,8 +3053,8 @@ SUBROUTINE DDRFT( & ! QA(2) = DOF WA(2) = DOFW - DOF = 1.1364d0 * BUD(L) * QRPI(L) - DOFW = -BUD(L) * STLT(L) + DOF = 1.1364_r8 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + QQQ * ST1 RNF(L) = QQQ * QRT(L) @@ -3123,8 +3124,8 @@ SUBROUTINE DDRFT( & QA(2) = DOF WA(2) = DOFW - DOF = 1.1364d0 * BUD(L) * QRPI(L) - DOFW = -BUD(L) * STLT(L) + DOF = 1.1364_r8 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + ST1 ! @@ -3258,7 +3259,7 @@ SUBROUTINE DDRFT( & ENDDO ! ! tem = 0.5 - if (tx2 > one .and. abs(errq-tx2) > 0.1d0) then + if (tx2 > one .and. abs(errq-tx2) > 0.1_r8) then tem = half !! elseif (tx2 < 0.1) then !! tem = 1.2 @@ -3281,17 +3282,17 @@ SUBROUTINE DDRFT( & ENDIF ELSE TEM = ERRQ - TX2 -! IF (TEM < ZERO .AND. ERRQ > 0.1d0) THEN - IF (TEM < ZERO .AND. ERRQ > 0.5d0) THEN +! IF (TEM < ZERO .AND. ERRQ > 0.1_r8) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5_r8) THEN ! IF (TEM < ZERO .and. & -! & (ntla < numtla .or. ERRQ > 0.5d0)) THEN +! & (ntla < numtla .or. ERRQ > 0.5_r8)) THEN SKPUP = .TRUE. ! No convergence ! - ERRQ = 10.0d0 ! No rain profile! + ERRQ = 10.0_r8 ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! - elseif (tem < zero .and. errq < 0.1d0) then + elseif (tem < zero .and. errq < 0.1_r8) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then errq = zero @@ -3309,7 +3310,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the ITR Loop!! ! - IF (ERRQ < 0.1d0) THEN + IF (ERRQ < 0.1_r8) THEN DDFT = .TRUE. RNB = - RNB ! do l=kd1,kb1-1 @@ -3330,7 +3331,7 @@ SUBROUTINE DDRFT( & TX1 = TX1 + RNF(L) ENDDO TX1 = TRAIN / (TX1+RNT+RNB) - IF (ABS(TX1-one) < 0.2d0) THEN + IF (ABS(TX1-one) < 0.2_r8) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 DO L=KD,KB1 @@ -3340,7 +3341,7 @@ SUBROUTINE DDRFT( & ELSE DDFT = .FALSE. - ERRQ = 10.0d0 + ERRQ = 10.0_r8 ENDIF ENDIF ! @@ -3364,7 +3365,7 @@ SUBROUTINE DDRFT( & WCB(L) = zero ENDDO ! - ERRQ = 10.0d0 + ERRQ = 10.0_r8 ! At this point stlt contains inverse of updraft vertical velocity 1/Wu. KK = MAX(KB1,KD1) @@ -3410,9 +3411,9 @@ SUBROUTINE DDRFT( & IF (RNT > zero) THEN if (TX1 > zero) THEN QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & - & ** (one/1.1364d0) + & ** (one/1.1364_r8) else - tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364d0) + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364_r8) endif RNTP = (one - RPART) * RNT BUY(KD) = - ROR(KD) * TX1 * QRP(KD) @@ -3473,7 +3474,7 @@ SUBROUTINE DDRFT( & VRW(1) = half * (GAM(L-1) + GAM(L)) VRW(2) = one / (VRW(1) + VRW(1)) ! - TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0d0*EKNOB) + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0_r8*EKNOB) ! DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! ! @@ -3481,7 +3482,7 @@ SUBROUTINE DDRFT( & HOD(L) = HOD(L-1) QOD(L) = QOD(L-1) ! - ERRQ = 10.0d0 + ERRQ = 10.0_r8 ! IF (L <= KBL) THEN @@ -3506,7 +3507,7 @@ SUBROUTINE DDRFT( & IF (L == KD1) THEN IF (RNT > zero) THEN TEM = MAX(QRP(L-1),QRP(L)) - WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0d0) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0_r8) ENDIF WVL(L) = MAX(ONE_M2, WVL(L)) TRW(1) = TRW(1) * half @@ -3634,9 +3635,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6_r8 + 124.9_r8 * QRAF) * QRBF * TX4 ! - CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) @@ -3647,7 +3648,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3668,7 +3669,7 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(TEM,ZERO) ELSEIF (TX5 > zero) THEN QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & - & ** (one/1.1364d0) + & ** (one/1.1364_r8) ELSE QRP(L) = zero ENDIF @@ -3695,7 +3696,7 @@ SUBROUTINE DDRFT( & ! WVL(L) = 0.5*tem1 ! WVL(L) = 0.1*tem1 ! WVL(L) = 0.0 - WVL(L) = 1.0d-10 + WVL(L) = 1.0e-10_r8 else WVL(L) = half*(WVL(L)+TEM1) endif @@ -3709,7 +3710,7 @@ SUBROUTINE DDRFT( & ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.2d0) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2_r8) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3721,7 +3722,7 @@ SUBROUTINE DDRFT( & TX5 = TX9 else TX5 = (STLT(KB1) * QRT(KB1) & - & + STLT(KBL) * QRB(KB1)) * (0.5d0*FAC) + & + STLT(KBL) * QRB(KB1)) * (0.5_r8*FAC) endif EVP(L-1) = zero @@ -3730,14 +3731,14 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364d0) + & ** (one/1.1364_r8) ! endif BUY(L) = - ROR(L) * TX5 * QRP(L) WCB(L-1) = zero ENDIF ! DEL_ETA = ETD(L) - ETD(L-1) - IF(DEL_ETA < zero .AND. ERRQ > 0.1d0) THEN + IF(DEL_ETA < zero .AND. ERRQ > 0.1_r8) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3764,9 +3765,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L-1) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6_r8 + 124.9_r8 * QRAF) * QRBF * TX4 ! - CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) @@ -3777,7 +3778,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3830,7 +3831,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the iteration loop for a given L! IF (L <= K) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.1d0 .and. l <= kbl) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1_r8 .and. l <= kbl) THEN !!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN ! & .AND. ERRQ > ERRMIN*10.0) THEN ROR(L) = BUD(KD) @@ -3853,7 +3854,7 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364d0) + & ** (one/1.1364_r8) ! ENDIF ETD(L) = zero WVL(L) = zero @@ -3884,7 +3885,7 @@ SUBROUTINE DDRFT( & ! not converge) , no downdraft is assumed ! ! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & - IF (ERRQ > 0.1d0 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. + IF (ERRQ > 0.1_r8 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. ! DOF = zero IF (.NOT. DDFT) RETURN @@ -3988,7 +3989,7 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys) es, d, hlorv, W ! ! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = min(p, 0.01d0 * fpvs(tt)) ! fpvs is in Pascals! + es = min(p, 0.01_r8 * fpvs(tt)) ! fpvs is in Pascals! ! D = one / max(p+epsm1*es,ONE_M10) D = one / (p+epsm1*es) ! @@ -4009,7 +4010,7 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) ! integer i ! - IF (TLA < 0.0d0) THEN + IF (TLA < 0.0_r8) THEN IF (PRES <= PLAC(1)) THEN TLA = TLAC(1) ELSEIF (PRES <= PLAC(2)) THEN @@ -4046,8 +4047,8 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) TEM = REFR(6) ENDIF ! - tem = 2.0d-4 / tem - al2 = min(4.0d0*tem, max(alm, tem)) + tem = 2.0e-4_r8 / tem + al2 = min(4.0_r8*tem, max(alm, tem)) ! RETURN end subroutine angrad @@ -4059,18 +4060,18 @@ SUBROUTINE SETQRP integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! XMIN = 1.0E-6 - XMIN = 0.0d0 - XMAX = 5.0d0 + XMIN = 0.0_r8 + XMAX = 5.0_r8 XINC = (XMAX-XMIN)/(NQRP-1) C2XQRP = one / XINC C1XQRP = one - XMIN*C2XQRP - TEM1 = 0.001d0 ** 0.2046d0 - TEM2 = 0.001d0 ** 0.525d0 + TEM1 = 0.001_r8 ** 0.2046_r8 + TEM2 = 0.001_r8 ** 0.525_r8 DO JX=1,NQRP X = XMIN + (JX-1)*XINC - TBQRP(JX) = X ** 0.1364d0 - TBQRA(JX) = TEM1 * X ** 0.2046d0 - TBQRB(JX) = TEM2 * X ** 0.525d0 + TBQRP(JX) = X ** 0.1364_r8 + TBQRA(JX) = TEM1 * X ** 0.2046_r8 + TBQRB(JX) = TEM2 * X ** 0.525_r8 ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN @@ -4095,12 +4096,12 @@ end subroutine qrabf SUBROUTINE SETVTP implicit none - real(kind=kind_phys), parameter :: vtpexp=-0.3636d0, one=1.0d0 + real(kind=kind_phys), parameter :: vtpexp=-0.3636_r8, one=1.0_r8 real(kind=kind_phys) xinc,x,xmax,xmin integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - XMIN = 0.05d0 - XMAX = 1.5d0 + XMIN = 0.05_r8 + XMAX = 1.5_r8 XINC = (XMAX-XMIN)/(NVTP-1) C2XVTP = one / XINC C1XVTP = one - XMIN*C2XVTP @@ -4147,10 +4148,10 @@ real(kind=kind_phys) FUNCTION CLF(PRATE) implicit none real(kind=kind_phys) PRATE ! - real (kind=kind_phys), parameter :: ccf1=0.30d0, ccf2=0.09d0 & - &, ccf3=0.04d0, ccf4=0.01d0 & - &, pr1=1.0d0, pr2=5.0d0 & - &, pr3=20.0d0 + real (kind=kind_phys), parameter :: ccf1=0.30_r8, ccf2=0.09_r8 & + &, ccf3=0.04_r8, ccf4=0.01_r8 & + &, pr1=1.0_r8, pr2=5.0_r8 & + &, pr3=20.0_r8 ! if (prate < pr1) then clf = ccf1 From f85730de98a126e7552b4bdc9d31ceb9c3ae067d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 10:58:03 +0000 Subject: [PATCH 13/97] updating to fix a potential snow bug --- physics/GFS_surface_composites.F90 | 36 +++++++++++++++++++----------- physics/sfc_cice.f | 22 ++++++++++++------ physics/sfc_cice.meta | 36 ++++++++++++++++++++++++++++++ 3 files changed, 74 insertions(+), 20 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index e12543328..22f5654a1 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -435,9 +435,10 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_lnd(i) qss(i) = qss_lnd(i) tsfc(i) = tsfc_lnd(i) - !hice(i) = zero - !cice(i) = zero - !tisfc(i) = tsfc(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) + tsfco(i) = tsfc(i) elseif (islmsk(i) == 0) then zorl(i) = zorl_ocn(i) cd(i) = cd_ocn(i) @@ -465,6 +466,7 @@ subroutine GFS_surface_composites_post_run ( hice(i) = zero cice(i) = zero tisfc(i) = tsfc(i) + tsfcl(i) = tsfc(i) else ! islmsk(i) == 2 zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) @@ -477,16 +479,6 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_ice(i) stress(i) = stress_ice(i) !tsurf(i) = tsurf_ice(i) - if (.not. flag_cice(i)) then - tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) - elseif (wet(i) .and. cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) - tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) - stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) - endif cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) @@ -499,6 +491,24 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) tsfc(i) = tsfc_ice(i) + tsfcl(i) = tsfc(i) + if (.not. flag_cice(i)) then + tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + elseif (wet(i) .and. cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) + qss(i) = txi * qss_ice(i) + txo * qss_ocn(i) + ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_ocn(i) + endif + if (wet(i)) then + tsfco(i) = tsfc_ocn(i) + else + tsfco(i) = tsfc(i) + endif endif zorll(i) = zorl_lnd(i) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index 9cb2b5f21..5fb61a7cc 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -44,9 +44,9 @@ subroutine sfc_cice_run & & ( im, cplflx, hvap, cp, rvrdm1, rd, & & t1, q1, cm, ch, prsl1, & & wind, flag_cice, flag_iter, dqsfc, dtsfc, & - & dusfc, dvsfc, & + & dusfc, dvsfc, snowd, & ! --- outputs: - & qsurf, cmm, chh, evap, hflx, stress, & + & qsurf, cmm, chh, evap, hflx, stress, weasd, snwdph, ep, & & errmsg, errflg & ) @@ -94,6 +94,8 @@ subroutine sfc_cice_run & use machine , only : kind_phys implicit none + real(kind=kind_phys), parameter :: one = 1.0_kind_phys + real(kind=kind_phys), parameter :: dsi = one/0.33_kind_phys real (kind=kind_phys), intent(in) :: hvap, cp, rvrdm1, rd ! --- inputs: @@ -103,12 +105,14 @@ subroutine sfc_cice_run & ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(im), intent(in) :: & & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc + &, snowd logical, intent(in) :: flag_cice(im), flag_iter(im) ! --- outputs: - real (kind=kind_phys), dimension(im), intent(out) :: qsurf, & + real (kind=kind_phys), dimension(im), intent(inout) :: qsurf, & & cmm, chh, evap, hflx, stress + &, weasd, snwdph, ep ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -127,24 +131,28 @@ subroutine sfc_cice_run & ! if (.not. cplflx) return ! - cpinv = 1.0d0/cp - hvapi = 1.0d0/hvap + cpinv = one / cp + hvapi = one / hvap elocp = hvap/cp ! do i = 1, im if (flag_cice(i) .and. flag_iter(i)) then rho = prsl1(i) & - & / (rd * t1(i) * (1.0d0 + rvrdm1*max(q1(i), 1.0d-8))) + & / (rd * t1(i) * (one + rvrdm1*max(q1(i), 1.0e-8_kind_phys))) cmm(i) = wind(i) * cm(i) chh(i) = wind(i) * ch(i) * rho qsurf(i) = q1(i) + dqsfc(i) / (hvap*chh(i)) - tem = 1.0d0 / rho + tem = one / rho hflx(i) = dtsfc(i) * tem * cpinv evap(i) = dqsfc(i) * tem * hvapi stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem + + weasd(i) = snowd(i) * 1000.0_kind_phys + snwdph(i) = weasd(i) * dsi ! snow depth in mm + ep(i) = evap(i) endif enddo diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index a1c57d4d9..3d26baf7a 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -159,6 +159,15 @@ kind = kind_phys intent = in optional = F +[snowd] + standard_name = surface_snow_thickness_for_coupling + long_name = sfc snow depth in meters over sea ice for coupling + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [qsurf] standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice @@ -213,6 +222,33 @@ kind = kind_phys intent = inout optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 02414491112c736f75081f26ad508c70925d265a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 11:09:44 +0000 Subject: [PATCH 14/97] fixing some comment lines --- physics/sfc_cice.f | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index 5fb61a7cc..2bda3a0c3 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -61,9 +61,9 @@ subroutine sfc_cice_run & ! ( im, cplflx, hvap, cp, rvrdm1, rd, ! ! t1, q1, cm, ch, prsl1, ! ! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! -! dusfc, dvsfc, ! +! dusfc, dvsfc, snowd, ! ! outputs: ! -! qsurf, cmm, chh, evap, hflx, stress) ! +! qsurf, cmm, chh, evap, hflx, stress, weasd, snwdph, ep) ! ! ! ! ==================== defination of variables ==================== ! ! ! @@ -81,6 +81,7 @@ subroutine sfc_cice_run & ! dtsfc - real, sensible heat flux ! dusfc - real, zonal momentum stress ! dvsfc - real, meridional momentum stress +! snowd - real, snow depth from cice ! outputs: ! qsurf - real, specific humidity at sfc ! cmm - real, ? @@ -88,6 +89,9 @@ subroutine sfc_cice_run & ! evap - real, evaperation from latent heat ! hflx - real, sensible heat ! stress - real, surface stress +! weasd - real, water equivalent accumulated snow depth (mm) +! snwdph - real, water equivalent snow depth (mm) +! ep - real, potential evaporation ! ==================== end of description ===================== ! ! ! From 4694c008851cceb7ef1977b48d00067f49fca69d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 14:20:19 +0000 Subject: [PATCH 15/97] some minor change with same result --- physics/GFS_surface_composites.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 22f5654a1..ae9724844 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -86,13 +86,14 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl if (cice(i) >= min_lakeice) then icy(i) = .true. else - cice(i) = zero - islmsk = 0 + cice(i) = zero + islmsk(i) = 0 endif endif if (cice(i) < one ) then wet(i)=.true. ! some open ocean/lake water exists - if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + if (.not. cplflx .or. oceanfrac(i) == zero) & + tsfco(i) = max(tsfco(i), tisfc(i), tgice) end if else cice(i) = zero From e216116dbccb9b456a3c3eaf33d7bc5cca890725 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Apr 2020 13:28:43 +0000 Subject: [PATCH 16/97] update consistent with ipd --- physics/sfc_cice.f | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index 2bda3a0c3..d2d0ae631 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -155,6 +155,7 @@ subroutine sfc_cice_run & stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem weasd(i) = snowd(i) * 1000.0_kind_phys + snwdph(i) = weasd(i) ! snow depth in mm snwdph(i) = weasd(i) * dsi ! snow depth in mm ep(i) = evap(i) endif From cdac822b69ce9691a0380e39b384383f0d718300 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 29 Apr 2020 13:09:25 +0000 Subject: [PATCH 17/97] testing an alternate option in ccpp --- physics/sfc_cice.f | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index d2d0ae631..f845f6091 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -154,9 +154,12 @@ subroutine sfc_cice_run & evap(i) = dqsfc(i) * tem * hvapi stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem - weasd(i) = snowd(i) * 1000.0_kind_phys - snwdph(i) = weasd(i) ! snow depth in mm - snwdph(i) = weasd(i) * dsi ! snow depth in mm + snwdph(i) = snowd(i) * 1000.0_kind_phys + weasd(i) = snwdph(i) * 0.33_kind_phys + +! weasd(i) = snowd(i) * 1000.0_kind_phys +! snwdph(i) = weasd(i) * dsi ! snow depth in mm + ep(i) = evap(i) endif enddo From d61ecbe02a64c872212644cd472de77ee73605e2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 30 Apr 2020 02:00:14 +0000 Subject: [PATCH 18/97] some additional updates to the code --- physics/GFS_MP_generic.F90 | 13 +- physics/dcyc2.f | 6 +- physics/gcm_shoc.F90 | 163 +++++++++++----------- physics/get_prs_fv3.F90 | 7 +- physics/m_micro.F90 | 272 +++++++++++++++++++------------------ physics/sfc_sice.f | 14 +- 6 files changed, 239 insertions(+), 236 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index ffbe6ab9b..4baf24e8c 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -259,7 +259,9 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt !! and determine explicit rain/snow by snow/ice/graupel coming out directly from MP !! and convective rainfall from the cumulus scheme if the surface temperature is below !! \f$0^oC\f$. + if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then + ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP @@ -305,15 +307,12 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt rain(i) = zero rainc(i) = zero endif - tprcp(i) = max(zero, rain(i) ) ! clu: rain -> tprcp + tprcp(i) = max(zero, rain(i)) enddo - else + else ! not GFDL or MG or Thompson microphysics do i = 1, im - tprcp(i) = max(zero, rain(i) ) ! clu: rain -> tprcp - srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) - if (t850(i) <= 273.16_kind_phys) then - srflag(i) = one ! clu: set srflag to 'snow' (i.e. 1) - endif + tprcp(i) = max(zero, rain(i)) + srflag(i) = sr(i) enddo endif endif diff --git a/physics/dcyc2.f b/physics/dcyc2.f index c7a1ddd59..6174f7641 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -286,10 +286,10 @@ subroutine dcyc2t3_run & istsun(i) = zero enddo do it=1,nstl - cns = solang + (float(it)-0.5)*anginc + slag + cns = solang + (float(it)-0.5_kind_phys)*anginc + slag do i = 1, IM coszn = sdec*sinlat(i) + cdec*coslat(i)*cos(cns+xlon(i)) - xcosz(i) = xcosz(i) + max(0.0, coszn) + xcosz(i) = xcosz(i) + max(zero, coszn) if (coszn > czlimt) istsun(i) = istsun(i) + 1 enddo enddo @@ -334,7 +334,7 @@ subroutine dcyc2t3_run & if ( xcosz(i) > f_eps .and. coszen(i) > f_eps ) then xmu(i) = xcosz(i) / coszen(i) else - xmu(i) = 0.0 + xmu(i) = zero endif !> - adjust \a sfc net and downward SW fluxes for zenith angle changes. diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 9baa61516..8e415fe75 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -10,6 +10,7 @@ module shoc private public shoc_run, shoc_init, shoc_finalize + integer, parameter :: r8 = kind_phys contains @@ -46,7 +47,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: epsq = 1.0d-20, zero=0.0d0, one=1.0d0 + real(kind=kind_phys), parameter :: epsq = 1.0e-20_r8, zero=0.0_r8, one=1.0_r8 integer :: i, k @@ -220,34 +221,34 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s - real, parameter :: zero=0.0d0, one=1.0d0, half=0.5d0, two=2.0d0, eps=0.622d0, & - three=3.0d0, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 - real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.d0, & - nmin = 1.0d0, RI_cub = 6.4d-14, RL_cub = 1.0d-15, & - skew_facw=1.2d0, skew_fact=0.d0, & - tkhmax=300.d0, qcmin=1.0d-9 - real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & + real, parameter :: zero=0.0_r8, one=1.0_r8, half=0.5_r8, two=2.0_r8, eps=0.622_r8, & + three=3.0_r8, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 + real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0_r8, & + nmin = 1.0_r8, RI_cub = 6.4e-14_r8, RL_cub = 1.0e-15_r8, & + skew_facw=1.2_r8, skew_fact=0.0_r8, & + tkhmax=300.0_r8, qcmin=1.0e-9_r8 + real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & rog, sqrtpii, epsterm, onebeps, onebrvcp ! SHOC tunable parameters - real, parameter :: lambda = 0.04d0 -! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 + real, parameter :: lambda = 0.04_r8 +! real, parameter :: min_tke = 1.0e-6_r8 ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0e-4_r8 ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0_r8 ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0_r8 ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000.0d0 - real, parameter :: max_eddy_length_scale = 1000.0d0 +! real, parameter :: max_eddy_length_scale = 2000.0_r8 + real, parameter :: max_eddy_length_scale = 1000.0_r8 ! Maximum "return-to-isotropy" time scale, s - real, parameter :: max_eddy_dissipation_time_scale = 2000.d0 - real, parameter :: Pr = 1.0d0 ! Prandtl number + real, parameter :: max_eddy_dissipation_time_scale = 2000.0_r8 + real, parameter :: Pr = 1.0_r8 ! Prandtl number ! Constants for the TKE dissipation term based on Deardorff (1980) - real, parameter :: pt19=0.19d0, pt51=0.51d0, pt01=0.01d0, atmin=0.01d0, atmax=one-atmin - real, parameter :: Cs = 0.15d0, epsln=1.0d-6 -! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 - real, parameter :: Ck = 0.1d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: pt19=0.19_r8, pt51=0.51_r8, pt01=0.01_r8, atmin=0.01_r8, atmax=one-atmin + real, parameter :: Cs = 0.15_r8, epsln=1.0e-6_r8 +! real, parameter :: Ck = 0.2_r8 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: Ck = 0.1_r8 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 @@ -260,29 +261,29 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce ! real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce*3.0/0.7 -! real, parameter :: vonk=0.35 ! Von Karman constant - real, parameter :: vonk=0.4d0 ! Von Karman constant Moorthi - as in GFS - real, parameter :: tscale=400.0d0 ! time scale set based off of similarity results of BK13, s - real, parameter :: w_tol_sqd = 4.0d-04 ! Min vlaue of second moment of w -! real, parameter :: w_tol_sqd = 1.0e-04 ! Min vlaue of second moment of w - real, parameter :: w_thresh = 0.0d0, thresh = 0.0d0 - real, parameter :: w3_tol = 1.0d-20 ! Min vlaue of third moment of w +! real, parameter :: vonk=0.35 ! Von Karman constant + real, parameter :: vonk=0.4_r8 ! Von Karman constant Moorthi - as in GFS + real, parameter :: tscale=400.0_r8 ! time scale set based off of similarity results of BK13, s + real, parameter :: w_tol_sqd = 4.0e-04_r8 ! Min vlaue of second moment of w +! real, parameter :: w_tol_sqd = 1.0e-04_r8 ! Min vlaue of second moment of w + real, parameter :: w_thresh = 0.0_r8, thresh = 0.0_r8 + real, parameter :: w3_tol = 1.0e-20_r8 ! Min vlaue of third moment of w ! These parameters are a tie-in with a microphysical scheme ! Double check their values for the Zhao-Carr scheme. - real, parameter :: tbgmin = 233.16d0 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 258.16d0 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 253.16d0 ! Minimum temperature for cloud water., K - real, parameter :: tbgmax = 273.16d0 ! Maximum temperature for cloud ice, K + real, parameter :: tbgmin = 233.16_r8 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 258.16_r8 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 253.16_r8 ! Minimum temperature for cloud water., K + real, parameter :: tbgmax = 273.16_r8 ! Maximum temperature for cloud ice, K real, parameter :: a_bg = one/(tbgmax-tbgmin) ! ! Parameters to tune the second order moments- No tuning is performed currently -! real, parameter :: thl2tune = 2.0d0, qw2tune = 2.0d0, qwthl2tune = 2.0d0, & - real, parameter :: thl2tune = 1.0d0, qw2tune = 1.0d0, qwthl2tune = 1.0d0, & -! thl_tol = 1.0d-4, rt_tol = 1.0d-8, basetemp = 300.0d0 - thl_tol = 1.0d-2, rt_tol = 1.0d-4 +! real, parameter :: thl2tune = 2.0_r8, qw2tune = 2.0_r8, qwthl2tune = 2.0_r8, & + real, parameter :: thl2tune = 1.0_r8, qw2tune = 1.0_r8, qwthl2tune = 1.0_r8, & +! thl_tol = 1.0e-4_r8, rt_tol = 1.0e-8_r8, basetemp = 300.0_r8 + thl_tol = 1.0e-2_r8, rt_tol = 1.0e-4_r8 integer, parameter :: nitr=6 @@ -454,7 +455,7 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & ! total_water(i,k) = qcl(i,k) + qci(i,k) + qv(i,k) - prespot = (100000.0d0*wrk) ** kapa ! Exner function + prespot = (100000.0_r8*wrk) ** kapa ! Exner function bet(i,k) = ggr/(tabs(i,k)*prespot) ! Moorthi thv(i,k) = thv(i,k)*prespot ! Moorthi ! @@ -636,8 +637,8 @@ subroutine tke_shoc() if (dis_opt > 0) then do i=1,nx - wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5d0 - cek(i) = (one + two / max((wrk*wrk - 3.3d0), 0.5d0)) * cefac + wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5_r8 + cek(i) = (one + two / max((wrk*wrk - 3.3_r8), 0.5_r8)) * cefac enddo else if (k == 1) then @@ -661,7 +662,7 @@ subroutine tke_shoc() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001d0) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001_r8) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) @@ -669,7 +670,7 @@ subroutine tke_shoc() if (buoy_sgs <= zero) then smix = grd else - smix = min(grd,max(0.1d0*grd, 0.76d0*sqrt(tke(i,k)/(buoy_sgs+1.0d-10)))) + smix = min(grd,max(0.1_r8*grd, 0.76_r8*sqrt(tke(i,k)/(buoy_sgs+1.0e-10_r8)))) endif ratio = smix/grd @@ -811,9 +812,9 @@ subroutine eddy_length() ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) do i=1,nx if (denom(i) > zero .and. numer(i) > zero) then - l_inf(i) = min(0.1d0 * (numer(i)/denom(i)), 100.0d0) + l_inf(i) = min(0.1_r8 * (numer(i)/denom(i)), 100.0_r8) else - l_inf(i) = 100.0d0 + l_inf(i) = 100.0_r8 endif enddo @@ -849,7 +850,7 @@ subroutine eddy_length() ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,k) / (wrk+1.0d-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.0e-20_r8) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp @@ -868,7 +869,7 @@ subroutine eddy_length() ! liquid/ice moist static energy static energy divided by cp? bbb = (one + epsv*qsatt-wrk-qpl(i,k)-qpi(i,k) & - + 1.61d0*tabs(i,k)*dqsat) / (one+lstarn*dqsat) + + 1.61_r8*tabs(i,k)*dqsat) / (one+lstarn*dqsat) ! Calculate Brunt-Vaisalla frequency using centered differences in the vertical @@ -918,7 +919,7 @@ subroutine eddy_length() wrk1 = one / (tscale*tkes*vonk*zl(i,k)) wrk2 = one / (tscale*tkes*l_inf(i)) wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,k) / tke(i,k) - wrk1 = sqrt(one / max(wrk1,1.0d-8)) * (one/0.3d0) + wrk1 = sqrt(one / max(wrk1,1.0e-8_r8)) * (one/0.3_r8) ! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) smixt(i,k) = min(max_eddy_length_scale, wrk1) @@ -989,7 +990,7 @@ subroutine eddy_length() ! The calculation below finds the integral in the Eq. 10 in BK13 for the current cloud conv_var = zero do kk=kl,ku - conv_var = conv_var+ 2.5d0*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) + conv_var = conv_var+ 2.5_r8*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) enddo conv_var = conv_var ** oneb3 @@ -1006,7 +1007,7 @@ subroutine eddy_length() wrk = conv_var/(depth*depth*sqrt(tke(i,kk))) & + pt01*brunt2(i,kk)/tke(i,kk) - smixt(i,kk) = min(max_eddy_length_scale, (one/0.3d0)*sqrt(one/wrk)) + smixt(i,kk) = min(max_eddy_length_scale, (one/0.3_r8)*sqrt(one/wrk)) enddo @@ -1053,7 +1054,7 @@ subroutine conv_scale() !********************************************************************** conv_vel2(i,k) = conv_vel2(i,k-1) & - + 2.5d0*adzi(i,k)*bet(i,k)*wthv_sec(i,k) + + 2.5_r8*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1084,7 +1085,7 @@ subroutine check_eddy() do i=1,nx - wrk = 0.1d0*adzl(i,k) + wrk = 0.1_r8*adzl(i,k) ! Minimum 0.1 of local dz smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) @@ -1092,7 +1093,7 @@ subroutine check_eddy() ! be not larger that that. ! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,kb) == zero .and. qcl(i,k) > zero .and. brunt(i,k) > 1.0d-4) then + if (qcl(i,kb) == zero .and. qcl(i,k) > zero .and. brunt(i,k) > 1.0e-4_r8) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz smixt(i,k) = wrk endif @@ -1118,10 +1119,10 @@ subroutine canuto() ! cond, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) - real, parameter :: c=7.0d0, a0=0.52d0/(c*c*(c-2.0d0)), a1=0.87d0/(c*c), & - a2=0.5d0/c, a3=0.6d0/(c*(c-2.0d0)), a4=2.4d0/(3.0d0*c+5.0d0), & - a5=0.6d0/(c*(3.0d0*c+5.0d0)) -!Moorthi a5=0.6d0/(c*(3.0d0+5.0d0*c)) + real, parameter :: c=7.0_r8, a0=0.52_r8/(c*c*(c-2.0_r8)), a1=0.87_r8/(c*c), & + a2=0.5_r8/c, a3=0.6_r8/(c*(c-2.0_r8)), a4=2.4_r8/(3.0_r8*c+5.0_r8), & + a5=0.6_r8/(c*(3.0_r8*c+5.0_r8)) +!Moorthi a5=0.6_r8/(c*(3.0_r8+5.0_r8*c)) ! do k=1,nzm do k=2,nzm @@ -1211,7 +1212,7 @@ subroutine canuto() omega0 = a4 / (one-a5*buoy_sgs2) omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5.0d0/4.0d0)*omega0*f4 + omega2 = omega1*f3+(5.0_r8/4.0_r8)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) @@ -1234,7 +1235,7 @@ subroutine canuto() !aab ! Implemetation of the C01 approach in this subroutine is nearly complete @@ -1288,7 +1289,7 @@ subroutine assumed_pdf() diag_qi = zero pval = prsl(i,k) - pfac = pval * 1.0d-5 + pfac = pval * 1.0e-5_r8 pkap = pfac ** kapa ! Read in liquid/ice static energy, total water mixing ratio, @@ -1362,21 +1363,21 @@ subroutine assumed_pdf() ELSE !aab Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi ! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4d0 - w2_2 = 0.4d0 + w2_1 = 0.4_r8 + w2_2 = 0.4_r8 ! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0d0*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0_r8*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) onema = one - aterm sqrtw2t = sqrt(wrk) @@ -1415,8 +1416,8 @@ subroutine assumed_pdf() ! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 wrk = three * (thl1_2-thl1_1) if (wrk /= zero) then - thl2_1 = thlsec * min(100.0d0,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - thl2_2 = thlsec * min(100.0d0,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + thl2_1 = thlsec * min(100.0_r8,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + thl2_2 = thlsec * min(100.0_r8,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 else thl2_1 = zero thl2_2 = zero @@ -1450,12 +1451,12 @@ subroutine assumed_pdf() ! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4d0) THEN + IF (tsign > 0.4_r8) THEN Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2d0) THEN + ELSEIF (tsign <= 0.2_r8) THEN Skew_qw = zero ELSE - Skew_qw = (skew_facw/0.2d0) * Skew_w * (tsign-0.2d0) + Skew_qw = (skew_facw/0.2_r8) * Skew_w * (tsign-0.2_r8) ENDIF wrk1 = qw1_1 * qw1_1 @@ -1465,8 +1466,8 @@ subroutine assumed_pdf() wrk = three * (qw1_2-qw1_1) if (wrk /= zero) then - qw2_1 = qwsec * min(100.0d0,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - qw2_2 = qwsec * min(100.0d0,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + qw2_1 = qwsec * min(100.0_r8,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + qw2_2 = qwsec * min(100.0_r8,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 else qw2_1 = zero qw2_2 = zero @@ -1512,18 +1513,18 @@ subroutine assumed_pdf() IF (Tl1_1 >= tbgmax) THEN lstarn1 = lcond esval = min(fpvsl(Tl1_1), pval) - qs1 = eps * esval / (pval-0.378d0*esval) + qs1 = eps * esval / (pval-0.378_r8*esval) ELSE IF (Tl1_1 <= tbgmin) THEN lstarn1 = lsub esval = min(fpvsi(Tl1_1), pval) - qs1 = epss * esval / (pval-0.378d0*esval) + qs1 = epss * esval / (pval-0.378_r8*esval) ELSE om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) lstarn1 = lcond + (one-om1)*lfus esval = min(fpvsl(Tl1_1), pval) esval2 = min(fpvsi(Tl1_1), pval) - qs1 = om1 * eps * esval / (pval-0.378d0*esval) & - + (one-om1) * epss * esval2 / (pval-0.378d0*esval2) + qs1 = om1 * eps * esval / (pval-0.378_r8*esval) & + + (one-om1) * epss * esval2 / (pval-0.378_r8*esval2) ENDIF ! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) @@ -1542,18 +1543,18 @@ subroutine assumed_pdf() IF (Tl1_2 >= tbgmax) THEN lstarn2 = lcond esval = min(fpvsl(Tl1_2), pval) - qs2 = eps * esval / (pval-0.378d0*esval) + qs2 = eps * esval / (pval-0.378_r8*esval) ELSE IF (Tl1_2 <= tbgmin) THEN lstarn2 = lsub esval = min(fpvsi(Tl1_2), pval) - qs2 = epss * esval / (pval-0.378d0*esval) + qs2 = epss * esval / (pval-0.378_r8*esval) ELSE om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) lstarn2 = lcond + (one-om2)*lfus esval = min(fpvsl(Tl1_2), pval) esval2 = min(fpvsi(Tl1_2), pval) - qs2 = om2 * eps * esval / (pval-0.378d0*esval) & - + (one-om2) * epss * esval2 / (pval-0.378d0*esval2) + qs2 = om2 * eps * esval / (pval-0.378_r8*esval) & + + (one-om2) * epss * esval2 / (pval-0.378_r8*esval2) ENDIF ! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 @@ -1663,14 +1664,14 @@ subroutine assumed_pdf() ! Update ncpl and ncpi Moorthi 12/12/2018 if (ntlnc > 0) then ! liquid and ice number concentrations predicted if (ncpl(i,k) > nmin) then - ncpl(i,k) = diag_ql/max(qc(i,k),1.0d-10)*ncpl(i,k) + ncpl(i,k) = diag_ql/max(qc(i,k),1.0e-10_r8)*ncpl(i,k) else - ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0d0), nmin) + ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0_r8), nmin) endif if (ncpi(i,k) > nmin) then - ncpi(i,k) = diag_qi/max(qi(i,k),1.0d-10)*ncpi(i,k) + ncpi(i,k) = diag_qi/max(qi(i,k),1.0e-10_r8)*ncpi(i,k) else - ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0d0), nmin) + ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0_r8), nmin) endif endif diff --git a/physics/get_prs_fv3.F90 b/physics/get_prs_fv3.F90 index dd5871896..352a61895 100644 --- a/physics/get_prs_fv3.F90 +++ b/physics/get_prs_fv3.F90 @@ -8,7 +8,7 @@ module get_prs_fv3 !--- local variables real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - real(kind=kind_phys), parameter :: half = 0.5_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -50,7 +50,7 @@ subroutine get_prs_fv3_run(ix, levs, phii, prsi, tgrs, qgrs1, del, del_gz, errms do i=1,ix del(i,k) = prsi(i,k) - prsi(i,k+1) del_gz(i,k) = (phii(i,k+1) - phii(i,k)) / & - (tgrs(i,k)*(1.+con_fvirt*max(zero,qgrs1(i,k)))) + (tgrs(i,k)*(one + con_fvirt*max(zero,qgrs1(i,k)))) enddo enddo @@ -78,6 +78,7 @@ module get_phi_fv3 !--- local variables real(kind=kind_phys), parameter :: zero = 0.0_kind_phys real(kind=kind_phys), parameter :: half = 0.5_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -118,7 +119,7 @@ subroutine get_phi_fv3_run(ix, levs, gt0, gq01, del_gz, phii, phil, errmsg, errf do k=1,levs do i=1,ix del_gz(i,k) = del_gz(i,k)*gt0(i,k) * & - & (1.+con_fvirt*max(zero,gq01(i,k))) + & (one + con_fvirt*max(zero,gq01(i,k))) phii(i,k+1) = phii(i,k) + del_gz(i,k) phil(i,k) = half*(phii(i,k) + phii(i,k+1)) enddo diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index ba7963e7d..aa2e70549 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -175,13 +175,14 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !------------------------------------ ! input ! real, parameter :: r_air = 3.47d-3 - real, parameter :: one=1.0_kind_phys, oneb3=one/3.0_kind_phys, onebcp=one/cp, & - zero=0.0_kind_phys, half=0.5_kind_phys, onebg=one/grav, & - & kapa=rgas*onebcp, cpbg=cp/grav, & - & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & - & qsmall=1.0e-14_kind_phys, rainmin = 1.0e-13_kind_phys, & - & fourb3=4.0_kind_phys/3.0_kind_phys, RL_cub=1.0e-15_kind_phys, & - & nmin=1.0_kind_phys + integer, parameter :: r8 = kind_phys + real, parameter :: one=1.0_r8, oneb3=one/3.0_r8, onebcp=one/cp, & + zero=0.0_r8, half=0.5_r8, onebg=one/grav, & + & kapa=rgas*onebcp, cpbg=cp/grav, & + & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & + & qsmall=1.0e-14_r8, rainmin = 1.0e-13_r8, & + & fourb3=4.0_r8/3.0_r8, RL_cub=1.0e-15_r8, & + & nmin=1.0_r8 integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag, iccn @@ -355,27 +356,27 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! real (kind=kind_phys), parameter :: disp_liu=2., ui_scale=1.0 & ! &, dcrit=20.0d-6 & - real (kind=kind_phys), parameter :: disp_liu=1.0_kind_phys & - &, ui_scale=1.0_kind_phys & - &, dcrit=1.0e-6_kind_phys & + real (kind=kind_phys), parameter :: disp_liu=1.0_r8 & + &, ui_scale=1.0_r8 & + &, dcrit=1.0e-6_r8 & ! &, ts_autice=1800.0 & ! &, ts_autice=3600.0 & !time scale - &, ninstr8 = 0.1e6_kind_phys & - &, ncnstr8 = 100.0e6_kind_phys + &, ninstr8 = 0.1e6_r8 & + &, ncnstr8 = 100.0e6_r8 real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_r8 real(kind=kind_phys):: t_ice_denom integer, dimension(1) :: lev_sed_strt ! sedimentation start level - real(kind=kind_phys), parameter :: sig_sed_strt=0.05_kind_phys ! normalized pressure at sedimentation start + real(kind=kind_phys), parameter :: sig_sed_strt=0.05_r8 ! normalized pressure at sedimentation start real(kind=kind_phys),dimension(3) :: ccn_diag real(kind=kind_phys),dimension(58) :: cloudparams integer, parameter :: CCN_PARAM=2, IN_PARAM=5 - real(kind=kind_phys), parameter ::fdust_drop=1.0_kind_phys, fsoot_drop=0.1_kind_phys & - &, sigma_nuc_r8=0.28_kind_phys,SCLMFDFR=0.03_kind_phys + real(kind=kind_phys), parameter ::fdust_drop=1.0_r8, fsoot_drop=0.1_r8 & + &, sigma_nuc_r8=0.28_r8,SCLMFDFR=0.03_r8 ! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1 type (AerProps), dimension (IM,LM) :: AeroProps @@ -390,22 +391,22 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !================== Start Stratiform cloud processes========================================== !set up initial values - data USE_AV_V/1./, BKGTAU/0.015/, LCCIRRUS/500./, NPRE_FRAC/1./, & - & TMAXLL/296./, fracover/1./, LTS_LOW/12./, LTS_UP/24./, & - & MIN_EXP/0.5/ - - data cloudparams/ & - & 10.0, 4.0 , 4.0 , 1.0 , 2.e-3, 8.e-4, 2.0 , 1.0 , -1.0 & - &, 0.0 , 1.3 , 1.0e-9, 3.3e-4, 20.0 , 4.8 , 4.8 , 230.0 , 1.0 & - &, 1.0 , 230.0, 14400., 50.0 , 0.01 , 0.1 , 200.0, 0.0 , 0.0 & - &, 0.5 , 0.5 , 2000.0, 0.8 , 0.5 , -40.0, 1.0 , 4.0 , 0.0 & - &, 0.0 , 0.0 , 1.0e-3, 8.0e-4, 1.0 , 0.95 , 1.0 , 0.0 , 900.0& -! &, 0.0 , 0.0 , 1.0e-3, 8.0e-4, 1.0 , 0.95 , 1.0 , 0.0 , 880.0& -! &, 0.0 , 0.0 , 1.0e-3, 8.0e-4, 1.0 , 0.95 , 1.0 , 0.0 , 980.0& - &, 1.0 , 1.0 , 1.0 , 0.0 , 0.0 , 1.e-5, 2.e-5, 2.1e-5, 4.e-5& -! &, 3e-5, 0.1 , 4.0 , 250./ ! Annings version - &, 3e-5, 0.1 , 4.0 , 150./ ! Annings version -! &, 3e-5, 0.1 , 1.0 , 150./ + data USE_AV_V/1.0_r8/, BKGTAU/0.015_r8/, LCCIRRUS/500.0_r8/, NPRE_FRAC/1.0_r8/, & + & TMAXLL/296.0_r8/, fracover/1.0_r8/, LTS_LOW/12.0_r8/, LTS_UP/24.0_r8/, & + & MIN_EXP/0.5_r8/ + + data cloudparams/ & + & 10.0_r8, 4.0_r8 , 4.0_r8 , 1.0_r8 , 2.e-3_r8, 8.e-4_r8, 2.0_r8 , 1.0_r8 , -1.0_r8 & + &, 0.0_r8 , 1.3_r8 , 1.0e-9_r8, 3.3e-4_r8, 20.0_r8 , 4.8_r8 , 4.8_r8 , 230.0_r8 , 1.0_r8 & + &, 1.0_r8 , 230.0_r8, 14400._r8, 50.0_r8 , 0.01_r8 , 0.1_r8 , 200.0_r8, 0.0_r8 , 0.0_r8 & + &, 0.5_r8 , 0.5_r8 , 2000.0_r8, 0.8_r8 , 0.5_r8 , -40.0_r8, 1.0_r8 , 4.0_r8 , 0.0_r8 & + &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 900.0_r8& +! &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 880.0_r8& +! &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 980.0_r8& + &, 1.0_r8 , 1.0_r8 , 1.0_r8 , 0.0_r8 , 0.0_r8 , 1.e-5_r8, 2.e-5_r8, 2.1e-5_r8, 4.e-5_r8& +! &, 3e-5_r8, 0.1_r8 , 4.0_r8 , 250.0_r8/ ! Annings version + &, 3e-5_r8, 0.1_r8 , 4.0_r8 , 150.0_r8/ ! Annings version +! &, 3e-5_r8, 0.1_r8 , 1.0_r8 , 150.0_r8/ ! Initialize CCPP error handling variables errmsg = '' @@ -441,7 +442,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,ll) CLCN(I,k) = CLCN_i(I,ll) CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) - PLO(i,k) = prsl_i(i,ll)*0.01_kind_phys + PLO(i,k) = prsl_i(i,ll)*0.01_r8 zlo(i,k) = phil(i,ll) * onebg temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) @@ -456,7 +457,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) * 0.01_kind_phys ! interface pressure in hPa + PLE(i,k) = prsi_i(i,ll) * 0.01_r8 ! interface pressure in hPa zet(i,k+1) = phii(i,ll) * onebg END DO END DO @@ -501,7 +502,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,k) CLCN(I,k) = CLCN_i(I,k) CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) - PLO(i,k) = prsl_i(i,k)*0.01_kind_phys + PLO(i,k) = prsl_i(i,k)*0.01_r8 zlo(i,k) = phil(i,k) * onebg temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) @@ -515,7 +516,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO DO K=0, LM DO I = 1,IM - PLE(i,k) = prsi_i(i,k) * 0.01_kind_phys ! interface pressure in hPa + PLE(i,k) = prsi_i(i,k) * 0.01_r8 ! interface pressure in hPa zet(i,k+1) = phii(i,k) * onebg END DO END DO @@ -554,17 +555,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif enddo @@ -578,8 +579,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I=1, IM DO K = LM-2, 10, -1 - If ((CNV_DQLDT(I,K) <= 1.0e-9_kind_phys) .and. & - & (CNV_DQLDT(I,K+1) > 1.0e-9_kind_phys)) then + If ((CNV_DQLDT(I,K) <= 1.0e-9_r8) .and. & + & (CNV_DQLDT(I,K+1) > 1.0e-9_r8)) then KCT(I) = K+1 exit end if @@ -659,7 +660,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=lm-1,1,-1 do i=1,im tx1 = half * (temp(i,l+1) + temp(i,l)) - kh(i,l) = 3.55e-7_kind_phys*tx1**2.5_kind_phys*(rgas*0.01_kind_phys) / ple(i,l) !kh molecule diff only needing refinement + kh(i,l) = 3.55e-7_r8*tx1**2.5_r8*(rgas*0.01_r8) / ple(i,l) !kh molecule diff only needing refinement enddo end do do i=1,im @@ -668,8 +669,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo do L=LM,1,-1 do i=1,im - blk_l(i,l) = one / ( one/max(0.15_kind_phys*ZPBL(i),0.4_kind_phys*zlo(i,lm-1))& - & + one/(zlo(i,l)*0.4_kind_phys) ) + blk_l(i,l) = one / ( one/max(0.15_r8*ZPBL(i),0.4_r8*zlo(i,lm-1))& + & + one/(zlo(i,l)*0.4_r8) ) SC_ICE(i,l) = one NCPL(i,l) = MAX( NCPL(i,l), zero) @@ -688,8 +689,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=1,lm - rhdfdar8(l) = 1.e-8_kind_phys - rhu00r8(l) = 0.95_kind_phys + rhdfdar8(l) = 1.e-8_r8 + rhu00r8(l) = 0.95_r8 ttendr8(l) = zero qtendr8(l) = zero @@ -699,7 +700,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo do k=1,10 do l=1,lm - rndstr8(l,k) = 2.0d-7 + rndstr8(l,k) = 2.0e-7_r8 enddo enddo @@ -734,8 +735,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if ( iccn == 2) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else - AERMASSMIX(:,:,1:5) = 1.0e-6_kind_phys - AERMASSMIX(:,:,6:15) = 2.0e-14_kind_phys + AERMASSMIX(:,:,1:5) = 1.0e-6_r8 + AERMASSMIX(:,:,6:15) = 2.0e-14_r8 end if !> - Call aerconversion1() call AerConversion1 (AERMASSMIX, AeroProps) @@ -754,23 +755,23 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kcldtopcvn = KCT(I) tausurf_gw = min(half*SQRT(TAUOROX(I)*TAUOROX(I) & - & + TAUOROY(I)*TAUOROY(I)), 10.0_kind_phys) + & + TAUOROY(I)*TAUOROY(I)), 10.0_r8) do k=1,lm uwind_gw(k) = min(half*SQRT( U1(I,k)*U1(I,k) & - & + V1(I,k)*V1(I,k)), 50.0_kind_phys) + & + V1(I,k)*V1(I,k)), 50.0_r8) ! tausurf_gw =tausurf_gw + max (tausurf_gw, min(0.5*SQRT(TAUX(I , J)**2+TAUY(I , J)**2), 10.0)*BKGTAU) !adds a minimum value from unresolved sources - pm_gw(k) = 100.0_kind_phys*PLO(I,k) + pm_gw(k) = 100.0_r8*PLO(I,k) tm_gw(k) = TEMP(I,k) nm_gw(k) = zero rho_gw(k) = pm_gw(k) /(RGAS*tm_gw(k)) ter8(k) = TEMP(I,k) - plevr8(k) = 100.0_kind_phys*PLO(I,k) + plevr8(k) = 100.0_r8*PLO(I,k) ndropr8(k) = NCPL(I,k) qir8(k) = QILS(I,k) + QICN(I,k) qcr8(k) = QLLS(I,k) + QLCN(I,k) @@ -781,27 +782,27 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & npre8(k) = zero - if (RAD_CF(I,k) > 0.01_kind_phys .and. qir8(k) > zero) then + if (RAD_CF(I,k) > 0.01_r8 .and. qir8(k) > zero) then npre8(k) = NPRE_FRAC*NCPI(I,k) else npre8(k) = zero endif omegr8(k) = OMEGA(I,k) - lc_turb(k) = max(blk_l(I,k), 50.0_kind_phys) + lc_turb(k) = max(blk_l(I,k), 50.0_r8) ! rad_cooling(k) = RADheat(I,k) if (npre8(k) > zero .and. qir8(k) > zero) then - dpre8(k) = ( qir8(k)/(6.0_kind_phys*npre8(k)*900.0_kind_phys*PI))**(one/3.0_kind_phys) + dpre8(k) = ( qir8(k)/(6.0_r8*npre8(k)*900.0_r8*PI))**(one/3.0_r8) else - dpre8(k) = 1.0e-9_kind_phys + dpre8(k) = 1.0e-9_r8 endif wparc_ls(k) = -omegr8(k) / (rho_gw(k)*GRAV) & & + cpbg * radheat(i,k) ! & + cpbg * rad_cooling(k) enddo do k=0,lm - pi_gw(k) = 100.0_kind_phys*PLE(I,k) + pi_gw(k) = 100.0_r8*PLE(I,k) rhoi_gw(k) = zero ni_gw(k) = zero ti_gw(k) = zero @@ -817,13 +818,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & ti_gw, nm_gw, q1(i,:)) do k=1,lm - nm_gw(k) = max(nm_gw(k), 0.005_kind_phys) + nm_gw(k) = max(nm_gw(k), 0.005_r8) h_gw(k) = k_gw*rho_gw(k)*uwind_gw(k)*nm_gw(k) if (h_gw(K) > zero) then - h_gw(K) = sqrt(2.0_kind_phys*tausurf_gw/h_gw(K)) + h_gw(K) = sqrt(2.0_r8*tausurf_gw/h_gw(K)) end if - wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133_kind_phys + wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133_r8 wparc_cgw(k) = zero end do @@ -840,14 +841,14 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do k=1,kcldtopcvn c2_gw = (nm_gw(k) + Nct) / Nct - wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56_kind_phys* & - & 1.806_kind_phys*c2_gw*c2_gw)*Wct*0.133_kind_phys + wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56_r8* & + & 1.806_r8*c2_gw*c2_gw)*Wct*0.133_r8 enddo end if do k=1,lm - dummyW(k) = 0.133_kind_phys*k_gw*uwind_gw(k)/nm_gw(k) + dummyW(k) = 0.133_r8*k_gw*uwind_gw(k)/nm_gw(k) enddo do K=1, LM-5, 1 @@ -867,17 +868,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & kbmin = min(kbmin, LM-1) - 4 do K = 1, LM wparc_turb(k) = KH(I,k) / lc_turb(k) - dummyW(k) = 10.0_kind_phys + dummyW(k) = 10.0_r8 enddo - if (FRLAND(I) < 0.1_kind_phys .and. ZPBL(I) < 800.0_kind_phys .and. & - & TEMP(I,LM) < 298.0_kind_phys .and. TEMP(I,LM) > 274.0_kind_phys) then + if (FRLAND(I) < 0.1_r8 .and. ZPBL(I) < 800.0_r8 .and. & + & TEMP(I,LM) < 298.0_r8 .and. TEMP(I,LM) > 274.0_r8) then do K = 1, LM - dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01_kind_phys, 10.0_kind_phys),-10.0_kind_phys) + dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01_r8, 10.0_r8),-10.0_r8) dummyW(k) = one / (one+exp(dummyW(k))) enddo maxkh = max(maxval(KH(I,kbmin:LM-1)*nm_gw(kbmin:LM-1)/ & - & 0.17_kind_phys), 0.3_kind_phys) + & 0.17_r8), 0.3_r8) do K = 1, LM wparc_turb(k) = (one-dummyW(k))*wparc_turb(k) & & + dummyW(k)*maxkh @@ -885,7 +886,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & end if - wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2_kind_phys) + wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2_r8) @@ -903,11 +904,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do K = 1, LM - if (plevr8(K) > 70.0_kind_phys) then + if (plevr8(K) > 70.0_r8) then - ccn_diag(1) = 0.001_kind_phys - ccn_diag(2) = 0.004_kind_phys - ccn_diag(3) = 0.01_kind_phys + ccn_diag(1) = 0.001_r8 + ccn_diag(2) = 0.004_r8 + ccn_diag(3) = 0.01_r8 if (K > 2 .and. K <= LM-2) then tauxr8 = (ter8(K-1) + ter8(K+1) + ter8(K)) * oneb3 @@ -944,7 +945,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! & size(ccn_diag), lprnt) ! if (lprnt) write(0,*)' aft aero npccninr8=',npccninr8(k),' k=',k - if (npccninr8(k) < 1.0d-12) npccninr8(k) = zero + if (npccninr8(k) < 1.0e-12_r8) npccninr8(k) = zero ! CCN01(I,K) = max(ccn_diag(1)*1e-6, 0.0) ! CCN04(I,K) = max(ccn_diag(2)*1e-6, 0.0) @@ -958,7 +959,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & swparc(K) = zero smaxicer8(K) = zero nheticer8(K) = zero - sc_icer8(K) = 2.0_kind_phys + sc_icer8(K) = 2.0_r8 ! sc_icer8(K) = 1.0d0 naair8(K) = zero npccninr8(K) = zero @@ -975,9 +976,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! SMAXL(I,k) = smaxliq(k) * 100.0 ! SMAXI(I,k) = smaxicer8(k) * 100.0 - NHET_NUC(I,k) = nheticer8(k) * 1.0e-6_kind_phys - NLIM_NUC(I,k) = nlimicer8(k) * 1.0e-6_kind_phys - SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0_kind_phys) + NHET_NUC(I,k) = nheticer8(k) * 1.0e-6_r8 + NLIM_NUC(I,k) = nlimicer8(k) * 1.0e-6_r8 + SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0_r8) ! SC_ICE(I,k) = min(max(sc_icer8(k),1.0),1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) @@ -987,13 +988,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (iccn == 0) then if(temp(i,k) < T_ICE_ALL) then ! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5_kind_phys) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5_r8) elseif(temp(i,k) > TICE) then SC_ICE(i,k) = rhc(i,k) else ! SC_ICE(i,k) = 1.0 ! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5_kind_phys) + tx1 = max(SC_ICE(I,k), 1.5_r8) SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & * t_ice_denom endif @@ -1004,12 +1005,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & endif NHET_IMM(I,k) = max(nhet_immr8(k), zero) DNHET_IMM(I,k) = max(dnhet_immr8(k), zero) - NHET_DEP(I,k) = nhet_depr8(k) * 1.0e-6_kind_phys - NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0e-6_kind_phys - DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0e-6_kind_phys - DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0e-6_kind_phys - DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0e-6_kind_phys - WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8_kind_phys + NHET_DEP(I,k) = nhet_depr8(k) * 1.0e-6_r8 + NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0e-6_r8 + DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0e-6_r8 + DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0e-6_r8 + DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0e-6_r8 + WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8_r8 SIGW_GW (I,k) = wparc_gw(k) * wparc_gw(k) SIGW_CNV (I,k) = wparc_cgw(k) * wparc_cgw(k) SIGW_TURB (I,k) = wparc_turb(k) * wparc_turb(k) @@ -1122,7 +1123,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do k=1,lm do i=1,im - if (CNV_MFD(i,k) > 1.0e-6_kind_phys) then + if (CNV_MFD(i,k) > 1.0e-6_r8) then tx1 = one / CNV_MFD(i,k) CNV_NDROP(i,k) = CNV_NDROP(i,k) * tx1 CNV_NICE(i,k) = CNV_NICE(i,k) * tx1 @@ -1231,7 +1232,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do l=1,10 do k=1,lm naconr8(k,l) = zero - rndstr8(k,l) = 2.0e-7_kind_phys + rndstr8(k,l) = 2.0e-7_r8 enddo enddo do k=1,lm @@ -1242,7 +1243,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! tx1 = MIN(CLLS(I,k) + CLCN(I,k), 0.99) tx1 = MIN(CLLS(I,k) + CLCN(I,k), one) if (tx1 > zero) then - cldfr8(k) = min(max(tx1, 0.00001_kind_phys), one) + cldfr8(k) = min(max(tx1, 0.00001_r8), one) else cldfr8(k) = zero endif @@ -1278,7 +1279,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & naair8(k) = INC_NUC(I,k) npccninr8(k) = CDNC_NUC(I,k) - if (cldfr8(k) >= 0.001_kind_phys) then + if (cldfr8(k) >= 0.001_r8) then nimmr8(k) = min(DNHET_IMM(I,k),ncr8(k)/(cldfr8(k)*DT_MOIST)) else nimmr8(k) = zero @@ -1306,11 +1307,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! naux = AeroAux_b%nmods ! rnsootr8 (K) = sum(AeroAux_b%dpg(1:naux))/naux - pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0_kind_phys + pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0_r8 rpdelr8(k) = one / pdelr8(k) - plevr8(k) = 100.0_kind_phys * PLO(I,k) + plevr8(k) = 100.0_r8 * PLO(I,k) zmr8(k) = ZLO(I,k) - ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0e-10_kind_phys) + ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0e-10_r8) omegr8(k) = WSUB(I,k) ! alphar8(k) = max(alpht_x(i,k)/maxval(alpht_x(i,:))*8.,0.5) ! alphar8(k) = qcvar2 @@ -1318,7 +1319,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & END DO do k=1,lm+1 - pintr8(k) = PLE(I,k-1) * 100.0_kind_phys + pintr8(k) = PLE(I,k-1) * 100.0_r8 kkvhr8(k) = KH(I,k-1) END DO @@ -1403,8 +1404,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if (lprint) write(0,*)' prectr8=',prectr8(1), & ! & ' precir8=',precir8(1) - LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) + LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_r8*precir8(1), zero) do k=1,lm @@ -1422,10 +1423,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPR(I,k) = nrr8(k) NCPS(I,k) = nsr8(k) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) - CLDREFFR(I,k) = max(droutr8(k)*0.5_kind_phys*1.0e6_kind_phys, 150.0_kind_phys) - CLDREFFS(I,k) = max(0.192_kind_phys*dsoutr8(k)*0.5_kind_phys*1.0e6_kind_phys, 250.0_kind_phys) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) + CLDREFFR(I,k) = max(droutr8(k)*0.5_r8*1.0e6_r8, 150.0_r8) + CLDREFFS(I,k) = max(0.192_r8*dsoutr8(k)*0.5_r8*1.0e6_r8, 250.0_r8) enddo ! K loop @@ -1507,8 +1508,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) + LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_r8*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1522,10 +1523,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) - CLDREFFR(I,k) = max(reff_rain(k), 150.0_kind_phys) - CLDREFFS(I,k) = max(reff_snow(k), 250.0_kind_phys) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) + CLDREFFR(I,k) = max(reff_rain(k), 150.0_r8) + CLDREFFS(I,k) = max(reff_snow(k), 250.0_r8) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1536,10 +1537,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0_kind_phys - CLDREFFI(I,k) = 50.0_kind_phys - CLDREFFR(I,k) = 1000.0_kind_phys - CLDREFFS(I,k) = 250.0_kind_phys + CLDREFFL(I,k) = 10.0_r8 + CLDREFFI(I,k) = 50.0_r8 + CLDREFFR(I,k) = 1000.0_r8 + CLDREFFS(I,k) = 250.0_r8 enddo ! K loop endif ! @@ -1644,8 +1645,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) - LS_PRC2(I) = max(1000.0_kind_phys*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_kind_phys*precir8(1), zero) + LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_r8*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1661,11 +1662,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kind_phys), 150.0_kind_phys) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_kind_phys), 150.0_kind_phys) - CLDREFFR(I,k) = max(reff_rain(k),150.0_kind_phys) - CLDREFFS(I,k) = max(reff_snow(k),250.0_kind_phys) - CLDREFFG(I,k) = max(reff_grau(k),250.0_kind_phys) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) + CLDREFFR(I,k) = max(reff_rain(k), 150.0_r8) + CLDREFFS(I,k) = max(reff_snow(k), 250.0_r8) + CLDREFFG(I,k) = max(reff_grau(k), 250.0_r8) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1676,11 +1677,11 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0_kind_phys - CLDREFFI(I,k) = 50.0_kind_phys - CLDREFFR(I,k) = 1000.0_kind_phys - CLDREFFS(I,k) = 250.0_kind_phys - CLDREFFG(I,k) = 250.0_kind_phys + CLDREFFL(I,k) = 10.0_r8 + CLDREFFI(I,k) = 50.0_r8 + CLDREFFR(I,k) = 1000.0_r8 + CLDREFFS(I,k) = 250.0_r8 + CLDREFFG(I,k) = 250.0_r8 enddo ! K loop endif endif @@ -1708,17 +1709,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif enddo enddo @@ -1748,17 +1749,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kind_phys), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kind_phys), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) endif enddo enddo @@ -1850,7 +1851,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) - rn_o(i) = tx1 * dt_i * 0.001_kind_phys + rn_o(i) = tx1 * dt_i * 0.001_r8 if (rn_o(i) < rainmin) then sr_o(i) = zero @@ -1903,6 +1904,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & use physcons, grav => con_g, cp => con_cp, rgas => con_rd, & fv => con_fvirt implicit none + integer, parameter :: r8 = kind_phys !----------------------------------------------------------------------- ! Compute profiles of background state quantities for the multiple ! gravity wave drag parameterization. @@ -1926,7 +1928,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & real(kind=kind_phys), intent(out) :: nm(pcols,pver) real(kind=kind_phys), parameter :: r=rgas, cpair=cp, g=grav, & - oneocp=1.0d0/cp, n2min=1.0d-8 + oneocp=1.0_r8/cp, n2min=1.0e-8_r8 !---------------------------Local storage------------------------------- integer :: ix,kx @@ -1942,15 +1944,15 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = 0 do ix = 1, ncol ti(ix,kx) = t(ix,kx+1) - rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0d0+fv*sph(ix,kx+1)))) + rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0_r8+fv*sph(ix,kx+1)))) ni(ix,kx) = sqrt (g*g / (cpair*ti(ix,kx))) end do ! Interior points use centered differences do kx = 1, pver-1 do ix = 1, ncol - ti(ix,kx) = 0.5d0 * (t(ix,kx) + t(ix,kx+1)) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+0.5d0*fv*(sph(ix,kx)+sph(ix,kx+1)))) + ti(ix,kx) = 0.5_r8 * (t(ix,kx) + t(ix,kx+1)) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_r8+0.5_r8*fv*(sph(ix,kx)+sph(ix,kx+1)))) dtdp = (t(ix,kx+1)-t(ix,kx)) / (pm(ix,kx+1)-pm(ix,kx)) n2 = g*g/ti(ix,kx) * (oneocp - rhoi(ix,kx)*dtdp) ni(ix,kx) = sqrt (max (n2min, n2)) @@ -1962,7 +1964,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = pver do ix = 1, ncol ti(ix,kx) = t(ix,kx) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+fv*sph(ix,kx))) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_r8+fv*sph(ix,kx))) ni(ix,kx) = ni(ix,kx-1) end do @@ -1971,7 +1973,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & !----------------------------------------------------------------------------- do kx=1,pver do ix=1,ncol - nm(ix,kx) = 0.5d0 * (ni(ix,kx-1) + ni(ix,kx)) + nm(ix,kx) = 0.5_r8 * (ni(ix,kx-1) + ni(ix,kx)) end do end do diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 8648e631b..bbd03a186 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -182,14 +182,14 @@ subroutine sfc_sice_run & ! --- locals: real (kind=kind_phys), dimension(im) :: ffw, evapi, evapw, & - & sneti, snetw, hfd, hfi, & + & sneti, hfd, hfi, & ! & hflxi, hflxw, sneti, snetw, qssi, qssw, hfd, hfi, hfw, & & focn, snof, rch, rho, & & snowd, theta1 real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) &, hflxi, hflxw, q0, qs1, qssi, qssw - real (kind=kind_phys) :: cpinv, hvapi, elocp + real (kind=kind_phys) :: cpinv, hvapi, elocp, snetw integer :: i, k integer, dimension(im) :: islmsk_local @@ -309,11 +309,11 @@ subroutine sfc_sice_run & evapw(i) = elocp * rch(i) * (qssw - q0) ! evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) - snetw(i) = sfcdsw(i) * (one - albfw) - snetw(i) = min(3.0_kind_phys*sfcnsw(i) & - & / (one+2.0_kind_phys*ffw(i)), snetw(i)) + snetw = sfcdsw(i) * (one - albfw) + snetw = min(3.0_kind_phys*sfcnsw(i) & + & / (one+2.0_kind_phys*ffw(i)), snetw) !> - Calculate net solar incoming at top \a sneti. - sneti(i) = (sfcnsw(i) - ffw(i)*snetw(i)) / fice(i) + sneti(i) = (sfcnsw(i) - ffw(i)*snetw) / fice(i) t12 = tice(i) * tice(i) t14 = t12 * t12 @@ -337,7 +337,7 @@ subroutine sfc_sice_run & ! --- ... hfw = net heat flux @ water surface (within ice) ! hfw(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapw(i) & -! & + rch(i)*(tgice - theta1(i)) - snetw(i) +! & + rch(i)*(tgice - theta1(i)) - snetw !> - Assigin heat flux from ocean \a focn and snowfall rate as constants, which !! should be from ocean model and other physics. From f245b7a614906d6bf4ec5822335362618f3b7ac4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 2 May 2020 23:38:19 +0000 Subject: [PATCH 19/97] some updates for several routines --- physics/GFS_rrtmg_pre.F90 | 2 +- physics/GFS_surface_composites.F90 | 14 ++-- physics/GFS_surface_generic.F90 | 4 - physics/moninshoc.f | 62 +++++++------- physics/tridi.f | 28 ++++--- physics/ugwp_driver_v0.F | 129 +++++++++++++++-------------- 6 files changed, 125 insertions(+), 114 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 01649793b..e2dad0f4d 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -473,7 +473,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !check print *,' in grrad : calling setaer ' call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & ! --- inputs - tracer1, Tbd%aer_nm, & + tracer1, Tbd%aer_nm, & Grid%xlon, Grid%xlat, IM, LMK, LMP, & Model%lsswr,Model%lslwr, & faersw,faerlw,aerodp) ! --- outputs diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index ae9724844..86eb28419 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -80,7 +80,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl else cice(i) = zero flag_cice(i) = .false. - islmsk = 0 + islmsk(i) = 0 endif else if (cice(i) >= min_lakeice) then @@ -91,10 +91,10 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl endif endif if (cice(i) < one ) then - wet(i)=.true. ! some open ocean/lake water exists - if (.not. cplflx .or. oceanfrac(i) == zero) & - tsfco(i) = max(tsfco(i), tisfc(i), tgice) - end if + wet(i) = .true. ! some open ocean/lake water exists + if ((.not. cplflx .or. oceanfrac(i) == zero) .and. icy(i)) & + tsfco(i) = max(tisfc(i), tgice) + endif else cice(i) = zero endif @@ -127,8 +127,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl endif endif if (cice(i) < one) then - wet(i)=.true. ! some open ocean/lake water exists - if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + wet(i) = .true. ! some open ocean/lake water exists + if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice) endif endif enddo diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 116b3e29f..ddcb8d72e 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -341,13 +341,9 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt snowca(i) = snowca(i) + snowc(i) * dtf snohfa(i) = snohfa(i) + snohf(i) * dtf ep(i) = ep(i) + ep1d(i) * dtf - enddo - endif ! --- ... total runoff is composed of drainage into water table and ! runoff at the surface and is accumulated in unit of meters - if (lssav) then - do i=1,im runoff(i) = runoff(i) + (drain(i)+runof(i)) * dtf srunoff(i) = srunoff(i) + runof(i) * dtf enddo diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 4afe19dec..14aaf1660 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -102,13 +102,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! &, dkmin=zero, dkmax=1000., xkzminv=0.3 &, prmin=0.25_r8, prmax=4.0_r8, vk=0.4_r8, & cfac=6.5_r8 - real(kind=kind_phys) :: gravi, cont, conq, conw, gocp + real(kind=kind_phys) :: gravi, cont, conq, gocp, go2 - gravi = one/grav - cont = cp/grav - conq = hvap/grav - conw = one/grav - gocp = grav/cp + gravi = one / grav + cont = cp * gravi + conq = hvap * gravi + gocp = grav / cp + go2 = grav * 0.5_r8 ! Initialize CCPP error handling variables errmsg = '' @@ -121,7 +121,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (ix < im) stop ! dt2 = delt - rdt = 1. / dt2 + rdt = one / dt2 km1 = km - 1 kmpbl = km / 2 ! @@ -202,13 +202,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo do i = 1,im theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) - thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-tx1(i)) + thvx(i,k) = theta(i,k)*(one+fv*max(q1(i,k,1),qmin)-tx1(i)) enddo enddo ! do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) - if(.not.sfcflg(i) .or. sflux(i) <= zero) pblflg(i)=.false. + if (.not.sfcflg(i) .or. sflux(i) <= zero) pblflg(i)=.false. beta(i) = dt2 / (zi(i,2)-zi(i,1)) enddo ! @@ -219,7 +219,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, flg(i) = .false. rbup(i) = rbsoil(i) ! - if(pblflg(i)) then + if (pblflg(i)) then thermal(i) = thvx(i,1) crb(i) = crbcon else @@ -233,9 +233,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo do k = 1, kmpbl do i = 1, im - if(.not.flg(i)) then + if (.not.flg(i)) then rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), 1.) + spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), one) rbup(i) = (thvx(i,k)-thermal(i))*phil(i,k) & / (thvx(i,1)*spdk2) kpbl(i) = k @@ -246,7 +246,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, do i = 1,im if(kpbl(i) > 1) then k = kpbl(i) - if(rbdn(i) >= crb(i)) then + if (rbdn(i) >= crb(i)) then rbint = zero elseif(rbup(i) <= crb(i)) then rbint = one @@ -265,13 +265,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do i=1,im zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) - if(sfcflg(i)) then + if (sfcflg(i)) then zol(i) = min(zol(i),-zfmin) else zol(i) = max(zol(i),zfmin) endif zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) - if(sfcflg(i)) then + if (sfcflg(i)) then ! phim(i) = (1.-aphi16*zol1)**(-1./4.) ! phih(i) = (1.-aphi16*zol1)**(-1./2.) tem = one / max(one - aphi16*zol1, 1.0e-8_r8) @@ -294,7 +294,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo do k = 2, kmpbl do i = 1, im - if(.not.flg(i)) then + if (.not.flg(i)) then rbdn(i) = rbup(i) spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), one) rbup(i) = (thvx(i,k)-thermal(i)) * phil(i,k) @@ -348,8 +348,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, tem = u1(i,k) - u1(i,kp1) tem1 = v1(i,k) - v1(i,kp1) tem = (tem*tem + tem1*tem1) * rdz * rdz - bvf2 = (0.5_r8*grav)*(thvx(i,kp1)-thvx(i,k))*rdz - & / (t1(i,k)+t1(i,kp1)) + bvf2 = go2*(thvx(i,kp1)-thvx(i,k))*rdz / (t1(i,k)+t1(i,kp1)) ri = max(bvf2/tem,rimin) if(ri < zero) then ! unstable regime prnum(i,kp1) = one @@ -427,7 +426,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif ! -! solve tridiagonal problem for heat and moisture +! solve tridiagonal problem for heat, moisture and tracers ! call tridin(im,km,ntloc,al,ad,au,a1,a2,au,a1,a2) @@ -435,14 +434,18 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! recover tendencies of heat and moisture ! do k = 1,km - do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt - qtend = (a2(i,k)-q1(i,k,1)) * rdt - tau(i,k) = tau(i,k) + ttend - rtg(i,k,1) = rtg(i,k,1) + qtend - dtsfc(i) = dtsfc(i) + cont*del(i,k)*ttend - dqsfc(i) = dqsfc(i) + conq*del(i,k)*qtend - enddo + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + qtend = (a2(i,k)-q1(i,k,1)) * rdt + tau(i,k) = tau(i,k) + ttend + rtg(i,k,1) = rtg(i,k,1) + qtend + dtsfc(i) = dtsfc(i) + del(i,k)*ttend + dqsfc(i) = dqsfc(i) + del(i,k)*qtend + enddo + enddo + do i = 1,im + dtsfc(i) = dtsfc(i) * cont + dqsfc(i) = dqsfc(i) * conq enddo if(ntrac > 1) then is = 0 @@ -497,8 +500,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, vtend = (a2(i,k)-v1(i,k))*rdt du(i,k) = du(i,k) + utend dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + conw*del(i,k)*utend - dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend + tem = del(i,k) * gravi + dusfc(i) = dusfc(i) + tem * utend + dvsfc(i) = dvsfc(i) + tem * vtend enddo enddo ! diff --git a/physics/tridi.f b/physics/tridi.f index bd44bcc86..c8e77403b 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -9,6 +9,7 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) ! use machine , only : kind_phys implicit none + integer, parameter :: one = 1.0_kind_phys integer k,n,l,i real(kind=kind_phys) fk ! @@ -16,19 +17,19 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) & au(l,n-1),a1(l,n) ! do i=1,l - fk = 1./cm(i,1) + fk = one / cm(i,1) au(i,1) = fk*cu(i,1) a1(i,1) = fk*r1(i,1) enddo do k=2,n-1 do i=1,l - fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + fk = one / (cm(i,k)-cl(i,k)*au(i,k-1)) au(i,k) = fk*cu(i,k) a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) enddo enddo do i=1,l - fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + fk = one / (cm(i,n)-cl(i,n)*au(i,n-1)) a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) enddo do k=n-1,1,-1 @@ -48,6 +49,7 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc use machine , only : kind_phys implicit none + integer, parameter :: one = 1.0_kind_phys integer k,n,l,i real(kind=kind_phys) fk cc @@ -55,21 +57,21 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) & au(l,n-1),a1(l,n),a2(l,n) c---------------------------------------------------------------------- do i=1,l - fk = 1./cm(i,1) + fk = one / cm(i,1) au(i,1) = fk*cu(i,1) a1(i,1) = fk*r1(i,1) a2(i,1) = fk*r2(i,1) enddo do k=2,n-1 do i=1,l - fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + fk = one / (cm(i,k)-cl(i,k)*au(i,k-1)) au(i,k) = fk*cu(i,k) a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) enddo enddo do i=1,l - fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + fk = one / (cm(i,n)-cl(i,n)*au(i,n-1)) a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) enddo @@ -93,6 +95,7 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) cc use machine , only : kind_phys implicit none + integer, parameter :: one = 1.0_kind_phys integer is,k,kk,n,nt,l,i real(kind=kind_phys) fk(l) cc @@ -102,7 +105,7 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) & fkk(l,2:n-1) c----------------------------------------------------------------------- do i=1,l - fk(i) = 1./cm(i,1) + fk(i) = one / cm(i,1) au(i,1) = fk(i)*cu(i,1) a1(i,1) = fk(i)*r1(i,1) enddo @@ -114,7 +117,7 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo do k=2,n-1 do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + fkk(i,k) = one / (cm(i,k)-cl(i,k)*au(i,k-1)) au(i,k) = fkk(i,k)*cu(i,k) a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) enddo @@ -128,7 +131,7 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo enddo do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + fk(i) = one / (cm(i,n)-cl(i,n)*au(i,n-1)) a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) enddo do k = 1, nt @@ -163,6 +166,7 @@ subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) !! use machine , only : kind_phys implicit none + integer, parameter :: one = 1.0_kind_phys integer is,k,kk,n,nt,l,i real(kind=kind_phys) fk(l) !! @@ -172,7 +176,7 @@ subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) & fkk(l,2:n-1) !----------------------------------------------------------------------- do i=1,l - fk(i) = 1./cm(i,1) + fk(i) = one / cm(i,1) au(i,1) = fk(i)*cu(i,1) enddo do k = 1, nt @@ -183,7 +187,7 @@ subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) enddo do k=2,n-1 do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + fkk(i,k) = one / (cm(i,k)-cl(i,k)*au(i,k-1)) au(i,k) = fkk(i,k)*cu(i,k) enddo enddo @@ -196,7 +200,7 @@ subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) enddo enddo do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + fk(i) = one / (cm(i,n)-cl(i,n)*au(i,n-1)) enddo do k = 1, nt is = (k-1) * n diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..819c995a4 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -6,8 +6,8 @@ module sso_coorde ! pgd4=4 (4 timse taub, control pgwd=1) ! use machine, only: kind_phys - real(kind=kind_phys),parameter :: pgwd = 1._kind_phys - real(kind=kind_phys),parameter :: pgwd4 = 1._kind_phys + real(kind=kind_phys),parameter :: pgwd = 1.0_kind_phys + real(kind=kind_phys),parameter :: pgwd4 = 1.0_kind_phys end module sso_coorde ! ! @@ -37,6 +37,8 @@ subroutine cires_ugwp_driver_v0(me, master, implicit none !input + integer, parameter :: r8 = kind_phys + integer, intent(in) :: me, master integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr @@ -86,8 +88,9 @@ subroutine cires_ugwp_driver_v0(me, master, ! ! switches that activate impact of OGWs and NGWs along with eddy diffusion ! - real(kind=kind_phys), parameter :: pogw=1.0, pngw=1.0, pked=1.0 - &, ompked=1.0-pked + real(kind=kind_phys), parameter :: pogw=1.0_r8, pngw=1.0_r8 + &, pked=1.0_r8, zero=0.0_r8 + &, ompked=1.0_r8-pked ! ! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) ! @@ -102,7 +105,7 @@ subroutine cires_ugwp_driver_v0(me, master, endif do i=1,im - zlwb(i) = 0. + zlwb(i) = zero enddo ! ! 1) ORO stationary GWs @@ -128,13 +131,13 @@ subroutine cires_ugwp_driver_v0(me, master, else ! calling old GFS gravity wave drag as is do k=1,levs do i=1,im - pdvdt(i,k) = 0.0 - pdudt(i,k) = 0.0 - pdtdt(i,k) = 0.0 - pkdis(i,k) = 0.0 + pdvdt(i,k) = zero + pdudt(i,k) = zero + pdtdt(i,k) = zero + pkdis(i,k) = zero enddo enddo - if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + if (cdmbgwd(1) > zero.or. cdmbgwd(2) > zero)_r8 then call gwdps(im, im, im, levs, Pdvdt, Pdudt, Pdtdt & &, ugrs, vgrs, tgrs, qgrs & &, kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt& @@ -144,11 +147,11 @@ subroutine cires_ugwp_driver_v0(me, master, &, nmtvr, cdmbgwd(1:2), me, lprnt, ipr, rdxzb) endif - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 - du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + tau_mtb = zero ; tau_ogw = zero ; tau_tofd = zero + du3dt_mtb = zero ; du3dt_ogw = zero ; du3dt_tms= zero endif ! - if (cdmbgwd(3) > 0.0) then + if (cdmbgwd(3) > zero) then ! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing ! ---------------------------------------------- !-------- @@ -158,11 +161,11 @@ subroutine cires_ugwp_driver_v0(me, master, ! call slat_geos5(im, xlatd, tau_ngw) ! - if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then - if (cdmbgwd(4) > 0.0) then + if (abs(1.0_r8-cdmbgwd(3)) > 1.0e-6_r8) then + if (cdmbgwd(4) > zero) then do i=1,im - turb_fac(i) = 0.0 - tem(i) = 0.0 + turb_fac(i) = zero + tem(i) = zero enddo if (ntke > 0) then do k=1,(levs+levs)/3 @@ -178,7 +181,7 @@ subroutine cires_ugwp_driver_v0(me, master, rfac = 86400000 / dtp do i=1,im tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) - tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) + tau_ngw(i) = tau_ngw(i) * max(0.1_r8, min(5.0_r8, tx1)) enddo endif do i=1,im @@ -217,10 +220,10 @@ subroutine cires_ugwp_driver_v0(me, master, enddo endif - if (pogw == 0.0) then + if (pogw == zero) then ! zmtb = 0.; zogw =0. - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 - du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + tau_mtb = zero ; tau_ogw = zero ; tau_tofd = zero + du3dt_mtb = zero ; du3dt_ogw = zero ; du3dt_tms= zero endif return @@ -234,7 +237,7 @@ subroutine cires_ugwp_driver_v0(me, master, !------------------------------------------------------------------------------ do k=1,levs do i=1,im - ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 + ed_dudt(i,k) = zero ; ed_dvdt(i,k) = zero ; ed_dtdt(i,k) = zero enddo enddo @@ -300,6 +303,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, use sso_coorde, only : pgwd, pgwd4 !---------------------------------------- implicit none + integer, parameter :: r8 = kind_phys character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' integer, intent(in) :: im, km, imx, kdt integer, intent(in) :: me, master @@ -345,9 +349,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! cleff = 2.5*0.5e-5 * sqrt(192./768.) => Lh_eff = 1004. km ! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective !--------------------------------------------------------------------- - real(kind=kind_phys) :: gammin = 0.00999999 - real(kind=kind_phys), parameter :: nhilmax = 25. - real(kind=kind_phys), parameter :: sso_min = 3000. + real(kind=kind_phys) :: gammin = 0.00999999_r8 + real(kind=kind_phys), parameter :: nhilmax = 25.0_r8 + real(kind=kind_phys), parameter :: sso_min = 3000.0_r8 logical, parameter :: do_adjoro = .true. ! real(kind=kind_phys) :: shilmin, sgrmax, sgrmin @@ -421,7 +425,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) dxres = pi2*arad/float(IMX) - hdxres = 0.5*dxres + hdxres = 0.5_r8*dxres ! shilmin = sgrmin/nhilmax ! not used - Moorthi ! gammin = min(sso_min/dsmax, 1.) ! Moorthi - with this results are not reproducible @@ -1272,6 +1276,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! nov 2017 nh/rotational gw-modes for nh-fv3gfs ! --------------------------------------------------------------------------------- ! + use machine, only : kind_phys use ugwp_common , only : rgrav, grav, cpd, rd, rv &, omega2, rcpd2, pi, pi2, fv @@ -1290,6 +1295,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, implicit none !23456 + integer, parameter :: r8 = kind_phys integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles @@ -1316,8 +1322,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5 ! - real, parameter :: epsln = 1.0d-12 ! + real, parameter :: minvel = 0.5_r8 ! + real, parameter :: epsln = 1.0e-12_r8 ! + real, parameter :: zero = 0.0_r8, one = 1.0_r8, half = 0.5_r8 !vay-2018 @@ -1379,7 +1386,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! real :: rcpd, grav2cpd real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp - &, cpdi = 1.0d0/cpd + &, cpdi = one/cpd real :: expdis, fdis ! real :: fmode, expdis, fdis @@ -1391,10 +1398,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! do k=1,klev do j=1,klon - pdvdt(j,k) = 0.0 - pdudt(j,k) = 0.0 - pdtdt(j,k) = 0.0 - dked(j,k) = 0.0 + pdvdt(j,k) = zero + pdudt(j,k) = zero + pdtdt(j,k) = zero + dked(j,k) = zero phil(j,k) = philg(j,k) * rgrav enddo enddo @@ -1422,9 +1429,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, do iazi=1, nazd do jk=1,klev do jl=1,klon - zpu(jl,jk,iazi) = 0.0 -! zcrt(jl,jk,iazi) = 0.0 -! zdfl(jl,jk,iazi) = 0.0 + zpu(jl,jk,iazi) = zero +! zcrt(jl,jk,iazi) = zero +! zdfl(jl,jk,iazi) = zero enddo enddo enddo @@ -1440,23 +1447,23 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! --------------------------------------------- do jk=max(ilaunch,2),klev do jl=1,klon - tvc1 = tm1(jl,jk) * (1. +fv*qm1(jl,jk)) - tvm1 = tm1(jl,jk-1) * (1. +fv*qm1(jl,jk-1)) + tvc1 = tm1(jl,jk) * (one +fv*qm1(jl,jk)) + tvm1 = tm1(jl,jk-1) * (one +fv*qm1(jl,jk-1)) ! zthm1(jl,jk) = 0.5 *(tvc1+tvm1) - zthm1 = 2.0 / (tvc1+tvm1) - zuhm1(jl,jk) = 0.5 *(um1(jl,jk-1)+um1(jl,jk)) - zvhm1(jl,jk) = 0.5 *(vm1(jl,jk-1)+vm1(jl,jk)) + zthm1 = 2.0_r8 / (tvc1+tvm1) + zuhm1(jl,jk) = half *(um1(jl,jk-1)+um1(jl,jk)) + zvhm1(jl,jk) = half *(vm1(jl,jk-1)+vm1(jl,jk)) ! zrhohm1(jl,jk) = prsi(jl,jk)*rdi/zthm1(jl,jk) ! rho = p/(RTv) zrhohm1(jl,jk) = prsi(jl,jk)*rdi*zthm1 ! rho = p/(RTv) zdelp = phil(jl,jk)-phil(jl,jk-1) !>0 ...... dz-meters v_zmet(jl,jk) = zdelp + zdelp delpi(jl,jk) = grav / (prsi(jl,jk-1) - prsi(jl,jk)) vueff(jl,jk) = - & 2.e-5*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min + & 2.e-5_r8*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min ! ! zbn2(jl,jk) = grav2cpd/zthm1(jl,jk) zbn2(jl,jk) = grav2cpd*zthm1 - & * (1.0+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) + & * (one+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) enddo @@ -1605,8 +1612,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! copy zflux into all other azimuths ! -------------------------------- -! zact(:,:,:) = 1.0 ; zacc(:,:,:) = 1.0 - zact(:,:,:) = 1.0 +! zact(:,:,:) = one ; zacc(:,:,:) = one + zact(:,:,:) = one do iazi=2, nazd do inc=1,nwav do jl=1,klon @@ -1674,9 +1681,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, do inc=1, nwav zcin = zci(inc) if (abs(zcin) > epsln) then - zcinc = 1.0 / zcin + zcinc = one / zcin else - zcinc = 1.0 + zcinc = one endif do jl=1,klon !======================================================================= @@ -1688,12 +1695,12 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_wdp = v_kxw*v_cdp wdop2 = v_wdp* v_wdp cdf2 = v_cdp*v_cdp - c2f2(jL) - if (cdf2 > 0) then + if (cdf2 > zero) then kzw2 = (zBn2(jL,jk)-wdop2)/Cdf2 - v_kxw2 else - kzw2 = 0.0 + kzw2 = zero endif - if ( kzw2 > 0 ) then + if ( kzw2 > zero ) then v_kzw = sqrt(kzw2) ! !linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 @@ -1706,10 +1713,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_kzi = abs(v_kzw*v_kzw*vueff(jl,jk)/v_wdp*v_kzw) expdis = exp(-v_kzi*v_zmet(jl,jk)) else - v_kzi = 0. - expdis = 1.0 - v_kzw = 0. - v_cdp = 0. ! no effects of reflected waves + v_kzi = zero + expdis = one + v_kzw = zero + v_cdp = zero ! no effects of reflected waves endif ! fmode = zflux(jl,inc,iazi) @@ -1725,7 +1732,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! flux_tot - sat.flux ! zdep = zact(jl,inc,iazi)* (fdis-zfluxs) - if(zdep > 0.0 ) then + if(zdep > zero ) then ! subs on sat-limit zflux(jl,inc,iazi) = zfluxs zflux_z(jl,inc,jk) = zfluxs @@ -1739,7 +1746,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! ! integrate over spectral modes zpu(y, z, azimuth) zact(jl,inc,iazi)*zflux(jl,inc,iazi)*[d("zcinc")] ! - zdfdz_v(:,jk,iazi) = 0.0 + zdfdz_v(:,jk,iazi) = zero do inc=1, nwav zcinc = zdci(inc) ! dc-integration @@ -1779,8 +1786,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! do jk=1,klev+1 do jl=1,klon - taux(jl,jk) = 0.0 - tauy(jl,jk) = 0.0 + taux(jl,jk) = zero + tauy(jl,jk) = zero enddo enddo @@ -1842,10 +1849,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, if (kdt == 1 .and. mpi_id == master) then print *, 'vgw done ' ! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' + print *, maxval(pdudt)*86400, minval(pdudt)*86400, 'vgw ax' + print *, maxval(pdvdt)*86400, minval(pdvdt)*86400, 'vgw ay' print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' - print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' + print *, maxval(pdtdt)*86400, minval(pdtdt)*86400,'vgw eps' ! ! print *, ' ugwp -heating rates ' endif From e1463756cd229b110eeccfb9876ce66621c7dfba Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 4 May 2020 18:38:48 +0000 Subject: [PATCH 20/97] removed tisfcin_cpl and tseain_cpl as they are not needed --- physics/GFS_debug.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 6bf39d491..4b62f0f9f 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -414,8 +414,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%dtsfcin_cpl ', Coupling%dtsfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dqsfcin_cpl ', Coupling%dqsfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl ) From 513cb29b7572d3246b6cf44e7c857ddfdb23c13f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 5 May 2020 01:02:55 +0000 Subject: [PATCH 21/97] minor update to surface_composites --- physics/GFS_surface_composites.F90 | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index e334c2468..7ad60a473 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -496,15 +496,24 @@ subroutine GFS_surface_composites_post_run ( tsfcl(i) = tsfc(i) if (.not. flag_cice(i)) then tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) - elseif (wet(i) .and. cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) - tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) - stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) - qss(i) = txi * qss_ice(i) + txo * qss_ocn(i) - ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_ocn(i) + elseif (wet(i)) then + if (cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) + qss(i) = txi * qss_ice(i) + txo * qss_ocn(i) + ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_ocn(i) + else + evap(i) = evap_ocn(i) + hflx(i) = hflx_ocn(i) + tsfc(i) = tsfc_ocn(i) + stress(i) = stress_ocn(i) + qss(i) = qss_ocn(i) + ep1d(i) = ep1d_ocn(i) + endif endif if (wet(i)) then tsfco(i) = tsfc_ocn(i) From bbf56bb0c530bab0a1171dd32cf6be98c5854149 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 10 May 2020 01:13:12 +0000 Subject: [PATCH 22/97] merged with ccpp-physics, updated some code, tested coupled model with nsst model --- physics/GFS_PBL_generic.F90 | 53 +++++++------- physics/GFS_debug.F90 | 10 +-- physics/GFS_surface_composites.F90 | 6 +- physics/module_nst_model.f90 | 2 +- physics/sfc_nst.f | 112 ++++++++++++++++------------- physics/tridi.f | 22 +++--- 6 files changed, 109 insertions(+), 96 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 6d15a2f60..35d581749 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -92,6 +92,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, implicit none + integer, parameter :: r8 = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm @@ -115,9 +116,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real (kind=kind_phys), parameter :: zero = 0.0_r8, one=1.0_r8 + ! Parameters for canopy heat storage parametrization - real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 - real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + real (kind=kind_phys), parameter :: z0min=0.2_r8, z0max=one + real (kind=kind_phys), parameter :: u10min=2.5_r8, u10max=7.5_r8 ! Local variables integer :: i, k, kk, k1, n @@ -283,20 +286,20 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, do i=1,im hflxq(i) = hflx(i) evapq(i) = evap(i) - hffac(i) = 1.0 - hefac(i) = 1.0 + hffac(i) = one + hefac(i) = one enddo if (lheatstrg) then do i=1,im - tem = 0.01 * zorl(i) ! change unit from cm to m + tem = 0.01_r8 * zorl(i) ! change unit from cm to m tem1 = (tem - z0min) / (z0max - z0min) - hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) - tem = sqrt(u10m(i)**2+v10m(i)**2) + hffac(i) = z0fac * min(max(tem1, zero), one) + tem = sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) tem1 = (tem - u10min) / (u10max - u10min) - tem2 = 1.0 - min(max(tem1, 0.0), 1.0) + tem2 = one - min(max(tem1, zero), one) hffac(i) = tem2 * hffac(i) - hefac(i) = 1. + e0fac * hffac(i) - hffac(i) = 1. + hffac(i) + hefac(i) = one + e0fac * hffac(i) + hffac(i) = one + hffac(i) hflxq(i) = hflx(i) / hffac(i) evapq(i) = evap(i) / hefac(i) enddo @@ -339,6 +342,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, implicit none + integer, parameter :: r8 = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef logical, intent(in) :: trans_aero @@ -364,14 +368,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, dq3dt_ozone - real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & + real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag logical, dimension(:),intent(in) :: wet, dry, icy real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl - real(kind=kind_phys), dimension(:,:), intent(in) :: dkt + real(kind=kind_phys), dimension(:,:), intent(in) :: dkt ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness real(kind=kind_phys), dimension(im), intent(in) :: hffac, hefac @@ -379,11 +383,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: zero = 0.0d0 - real(kind=kind_phys), parameter :: one = 1.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_r8, one = 1.0_r8 real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 - real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90 - real(kind=kind_phys), parameter :: qmin = 1.0d-8 + real(kind=kind_phys), parameter :: epsln = 1.0e-10_r8 ! same as in GFS_physics_driver.F90 + real(kind=kind_phys), parameter :: qmin = 1.0e-8_r8 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, rho @@ -438,12 +441,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Ferrier-Aligo do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntqv) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) dqdt(i,k,nqrimef) = dvdftra(i,k,5) - dqdt(i,k,ntoz) = dvdftra(i,k,6) + dqdt(i,k,ntoz) = dvdftra(i,k,6) enddo enddo @@ -592,14 +595,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, !-------------------------------------------------------lssav if loop ---------- if (lssav) then do i=1,im - dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf - dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf - dtsfc_diag (i) = dtsfc_diag(i) + dtsfc1(i)*hffac(i)*dtf - dqsfc_diag (i) = dqsfc_diag(i) + dqsfc1(i)*hefac(i)*dtf + dusfc_diag (i) = dusfc_diag(i) + dusfc1(i) * dtf + dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i) * dtf dusfci_diag(i) = dusfc1(i) dvsfci_diag(i) = dvsfc1(i) dtsfci_diag(i) = dtsfc1(i)*hffac(i) dqsfci_diag(i) = dqsfc1(i)*hefac(i) + dtsfc_diag (i) = dtsfc_diag(i) + dtsfci_diag(i) * dtf + dqsfc_diag (i) = dqsfc_diag(i) + dqsfci_diag(i) * dtf enddo if (ldiag3d) then diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4b62f0f9f..ac4641a4b 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -402,9 +402,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if - if (Model%cplwav2atm) then - call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) - end if +! if (Model%cplwav2atm) then +! call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) +! end if if (Model%cplflx) then call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) @@ -416,8 +416,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl ) ! call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) ! call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dusfc_cpl ', Coupling%dusfc_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dvsfc_cpl ', Coupling%dvsfc_cpl ) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 7ad60a473..3e2248652 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -453,7 +453,6 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_ocn(i) !tsurf(i) = tsurf_ocn(i) tsfco(i) = tsfc_ocn(i) ! over lake (and ocean when uncoupled) - if( cplflx ) tsfcl(i) = tsfc_ocn(i) ! for restart repro comparisons cmm(i) = cmm_ocn(i) chh(i) = chh_ocn(i) gflx(i) = gflx_ocn(i) @@ -492,8 +491,6 @@ subroutine GFS_surface_composites_post_run ( evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) - tsfc(i) = tsfc_ice(i) - tsfcl(i) = tsfc(i) if (.not. flag_cice(i)) then tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) elseif (wet(i)) then @@ -506,6 +503,7 @@ subroutine GFS_surface_composites_post_run ( stress(i) = txi * stress_ice(i) + txo * stress_ocn(i) qss(i) = txi * qss_ice(i) + txo * qss_ocn(i) ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_ocn(i) + zorl(i) = txi * zorl_ice(i) + txo * zorl_ocn(i) else evap(i) = evap_ocn(i) hflx(i) = hflx_ocn(i) @@ -513,6 +511,7 @@ subroutine GFS_surface_composites_post_run ( stress(i) = stress_ocn(i) qss(i) = qss_ocn(i) ep1d(i) = ep1d_ocn(i) + zorl(i) = zorl_ocn(i) endif endif if (wet(i)) then @@ -520,6 +519,7 @@ subroutine GFS_surface_composites_post_run ( else tsfco(i) = tsfc(i) endif + tsfcl(i) = tsfc(i) endif zorll(i) = zorl_lnd(i) diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index 53bfb6be3..1e4d1a704 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -889,7 +889,7 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q zcsq = z_c * z_c a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - if ( hb > 0.0 ) then + if ( hb > 0.0 .and. zcsq > 0.0 .and. alpha > 0.0) then bc1 = zcsq * (q_ts+cc3*hl_ts) bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) zc_ts = bc1/bc2 diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 3d0507ad9..8c7343519 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -164,7 +164,7 @@ subroutine sfc_nst_run & ! ===================================================================== ! use machine , only : kind_phys use funcphys, only : fpvs - use date_def, only: idate + use date_def, only : idate use module_nst_water_prop, only: get_dtzm_point use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & & sigma_r,solar_time_6am,ri_c,z_w_max,delz,wd_max, & @@ -178,11 +178,14 @@ subroutine sfc_nst_run & & dtl_reset ! implicit none + + integer, parameter :: r8 = kind_phys ! ! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0 ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0 ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) + real (kind=kind_phys), parameter :: f24 = 24.0_r8 ! hours/day + real (kind=kind_phys), parameter :: f1440 = 1440.0_r8 ! minutes/day + real (kind=kind_phys), parameter :: czmin = 0.0001_r8 ! cos(89.994) + real (kind=kind_phys), parameter :: zero = 0.0_r8, one = 1.0_r8 ! --- inputs: @@ -252,11 +255,11 @@ subroutine sfc_nst_run & errmsg = '' errflg = 0 - cpinv = 1.0/cp - hvapi = 1.0/hvap + cpinv = one/cp + hvapi = one/hvap elocp = hvap/cp - sss = 34.0 ! temporarily, when sea surface salinity data is not ready + sss = 34.0_r8 ! temporarily, when sea surface salinity data is not ready ! ! flag for open water and where the iteration is on ! @@ -297,21 +300,21 @@ subroutine sfc_nst_run & nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - q0(i) = max(q1(i), 1.0e-8) + q0(i) = max(q1(i), 1.0e-8_r8) #ifdef GSD_SURFACE_FLUXES_BUGFIX theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer #else theta1(i) = t1(i) * prslki(i) #endif - tv1(i) = t1(i) * (1.0 + rvrdm1*q0(i)) + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) rho_a(i) = prsl1(i) / (rd*tv1(i)) qss(i) = fpvs(tsurf(i)) ! pa qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa ! - evap(i) = 0.0 - hflx(i) = 0.0 - gflux(i) = 0.0 - ep(i) = 0.0 + evap(i) = zero + hflx(i) = zero + gflux(i) = zero + ep(i) = zero ! --- ... rcp = rho cp ch v @@ -337,8 +340,8 @@ subroutine sfc_nst_run & ! run nst model: dtm + slm ! - zsea1 = 0.001*real(nstf_name4) - zsea2 = 0.001*real(nstf_name5) + zsea1 = 0.001_r8*real(nstf_name4) + zsea2 = 0.001_r8*real(nstf_name5) !> - Call module_nst_water_prop::density() to compute sea water density. !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion @@ -350,20 +353,20 @@ subroutine sfc_nst_run & ulwflx(i) = sfcemis(i) * sbc * t12 * t12 alon = xlon(i)*rad2deg grav = grv(sinlat(i)) - soltim = mod(alon/15.0 + solhr, 24.0)*3600.0 + soltim = mod(alon/15.0_r8 + solhr, 24.0_r8)*3600.0_r8 call density(tsea,sss,rho_w) ! sea water density call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta ! !> - Calculate sensible heat flux (\a qrain) due to rainfall. ! - le = (2.501-.00237*tsea)*1e6 - dwat = 2.11e-5*(t1(i)/t0k)**1.94 ! water vapor diffusivity - dtmp = (1.+3.309e-3*(t1(i)-t0k)-1.44e-6*(t1(i)-t0k)* - & (t1(i)-t0k))*0.02411/(rho_a(i)*cp) ! heat diffusivity + le = (2.501_r8-0.00237_r8*tsea)*1e6_r8 + dwat = 2.11e-5_r8*(t1(i)/t0k)**1.94_r8 ! water vapor diffusivity + dtmp = (one+3.309e-3_r8*(t1(i)-t0k)-1.44e-6_r8*(t1(i)-t0k) + & * (t1(i)-t0k))*0.02411_r8/(rho_a(i)*cp) ! heat diffusivity wetc = 622.0*le*qss(i)/(rd*t1(i)*t1(i)) - alfac = 1/(1+(wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - qrain(i) = (1000.*rain(i)/rho_w)*alfac*cp_w* - & (tsea-t1(i)+(1000.*qss(i)-1000.*q0(i))*le/cp) + alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor + tem = (1.0e3_r8 * rain(i) / rho_w) * alfac * cp_w + qrain(i) = tem * (tsea-t1(i)+1.0e3_r8*(qss(i)-q0(i))*le/cp) !> - Calculate input non solar heat flux as upward = positive to models here @@ -379,10 +382,10 @@ subroutine sfc_nst_run & ! ! sensitivities of heat flux components to ts ! - rnl_ts = 4.0*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) + rnl_ts = 4.0_r8*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) hs_ts = rch(i) hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) - rf_ts = (1000.*rain(i)/rho_w)*alfac*cp_w*(1.0+rch(i)*hl_ts) + rf_ts = tem * (one+rch(i)*hl_ts) q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts ! !> - Call cool_skin(), which is the sub-layer cooling parameterization @@ -393,7 +396,7 @@ subroutine sfc_nst_run & &, rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le &, dt_cool(i),z_c(i),c_0(i),c_d(i)) - tem = 1.0 / wndmag(i) + tem = one / wndmag(i) cosa = u1(i)*tem sina = v1(i)*tem taux = max(stress(i),tau_min)*cosa @@ -402,20 +405,20 @@ subroutine sfc_nst_run & ! ! Run DTM-1p system. ! - if ( (soltim > solar_time_6am .and. ifd(i) == 0.0) ) then + if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then else - ifd(i) = 1.0 + ifd(i) = one ! ! calculate fcl thickness with current forcing and previous time's profile ! ! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) !> - Call convdepth() to calculate depth for convective adjustments. - if ( f_nsol > 0.0 .and. xt(i) > 0.0 ) then + if ( f_nsol > zero .and. xt(i) > zero ) then call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w &, alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) else - d_conv(i) = 0.0 + d_conv(i) = zero endif ! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) @@ -443,7 +446,7 @@ subroutine sfc_nst_run & ! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) ! apply mda - if ( xt(i) > 0.0 ) then + if ( xt(i) > zero ) then !> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply !! minimum depth adjustment (mda). call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) @@ -458,7 +461,7 @@ subroutine sfc_nst_run & endif ! apply fca - if ( d_conv(i) > 0.0 ) then + if ( d_conv(i) > zero ) then !> - If thickness of free convection layer > 0.0, call dtm_1p_fca() !! to apply free convection adjustment. !> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() @@ -483,7 +486,7 @@ subroutine sfc_nst_run & !> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with !! thickness of \a dz. - if ( q_warm > 0.0 ) then + if ( q_warm > zero ) then call cal_ttop(kdt,timestep,q_warm,rho_w,dz, & xt(i),xz(i),ttop0) @@ -492,7 +495,7 @@ subroutine sfc_nst_run & ! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), ! &' xz=',xz(i),' qrain=',qrain(i) - ttop = ((xt(i)+xt(i))/xz(i))*(1.0-dz/((xz(i)+xz(i)))) + ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) ! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) ! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz @@ -543,7 +546,7 @@ subroutine sfc_nst_run & ! endif ! if ( xt(i) > 0.0 ) then ! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0*timestep ) then + if ( abs(soltim) < 2.0_r8*timestep ) then call dtl_reset & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) endif @@ -556,17 +559,17 @@ subroutine sfc_nst_run & !> - Call get_dtzm_point() to computes \a dtz and \a tsurf. call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), & zsea1,zsea2,dtz) - tsurf(i) = max(271.2, tref(i) + dtz ) + tsurf(i) = max(271.2_r8, tref(i) + dtz ) ! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', ! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) !> - Call cal_w() to calculate \a w_0 and \a w_d. - if ( xt(i) > 0.0 ) then + if ( xt(i) > zero ) then call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) else - w_0(i) = 0.0 - w_d(i) = 0.0 + w_0(i) = zero + w_d(i) = zero endif ! if ( xt(i) > 0.0 ) then @@ -634,7 +637,7 @@ subroutine sfc_nst_run & ! do i=1,im if ( flag(i) ) then - tem = 1.0 / rho_a(i) + tem = one / rho_a(i) hflx(i) = hflx(i) * tem * cpinv evap(i) = evap(i) * tem * hvapi endif @@ -682,6 +685,8 @@ subroutine sfc_nst_pre_run implicit none + integer, parameter :: r8 = kind_phys + ! --- inputs: integer, intent(in) :: im logical, dimension(im), intent(in) :: wet @@ -699,10 +704,10 @@ subroutine sfc_nst_pre_run ! --- locals integer :: i - real(kind=kind_phys), parameter :: zero = 0.0d0, - & one = 1.0d0, - & half = 0.5d0, - & omz1 = 10.0d0 + real(kind=kind_phys), parameter :: zero = 0.0_r8, + & one = 1.0_r8, + & half = 0.5_r8, + & omz1 = 10.0_r8 real(kind=kind_phys) :: tem1, tem2, dt_warm ! Initialize CCPP error handling variables @@ -725,7 +730,11 @@ subroutine sfc_nst_pre_run tem1 = half / omz1 do i=1,im if (wet(i) .and. oceanfrac(i) > zero) then - tem2 = one / xz(i) + if (abs(xz(i)) > zero) then + tem2 = one / xz(i) + else + tem2 = zero + endif dt_warm = (xt(i)+xt(i)) * tem2 if ( xz(i) > omz1) then tref(i) = tseal(i) - (one-half*omz1*tem2) * dt_warm & @@ -735,7 +744,7 @@ subroutine sfc_nst_pre_run & - z_c(i)*dt_cool(i))*tem1 endif tseal(i) = tref(i) + dt_warm - dt_cool(i) -! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse +! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse tsurf_ocn(i) = tseal(i) endif enddo @@ -787,6 +796,8 @@ subroutine sfc_nst_post_run & implicit none + integer, parameter :: r8 = kind_phys + ! --- inputs: integer, intent(in) :: im logical, dimension(im), intent(in) :: wet, icy @@ -827,12 +838,11 @@ subroutine sfc_nst_post_run & ! --- ... run nsst model ... --- - dtzm = 0.0 + dtzm = 0.0_r8 if (nstf_name1 > 1) then - zsea1 = 0.001*real(nstf_name4) - zsea2 = 0.001*real(nstf_name5) - call get_dtzm_2d (xt, xz, dt_cool, & - & z_c, wet, zsea1, zsea2, & + zsea1 = 0.001_r8*real(nstf_name4) + zsea2 = 0.001_r8*real(nstf_name5) + call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & & im, 1, dtzm) do i = 1, im ! if (wet(i) .and. .not.icy(i)) then diff --git a/physics/tridi.f b/physics/tridi.f index c8e77403b..0103b388f 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -41,21 +41,21 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) return end subroutine tridi1 -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- !>\ingroup satmedmf !>\ingroup satmedmfvdifq !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) -cc +! use machine , only : kind_phys implicit none integer, parameter :: one = 1.0_kind_phys integer k,n,l,i real(kind=kind_phys) fk -cc +! real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & & au(l,n-1),a1(l,n),a2(l,n) -c---------------------------------------------------------------------- +!---------------------------------------------------------------------- do i=1,l fk = one / cm(i,1) au(i,1) = fk*cu(i,1) @@ -81,29 +81,29 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) enddo enddo -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- return end subroutine tridi2 -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- !>\ingroup satmedmf !>\ingroup satmedmfvdifq !> Routine to solve the tridiagonal system to calculate u- and !! v-momentum at \f$ t + \Delta t \f$; part of two-part process to !! calculate time tendencies due to vertical diffusion. subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) -cc +! use machine , only : kind_phys implicit none integer, parameter :: one = 1.0_kind_phys integer is,k,kk,n,nt,l,i real(kind=kind_phys) fk(l) -cc +! real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & & r1(l,n), r2(l,n*nt), & & au(l,n-1), a1(l,n), a2(l,n*nt), & & fkk(l,2:n-1) -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- do i=1,l fk(i) = one / cm(i,1) au(i,1) = fk(i)*cu(i,1) @@ -153,11 +153,11 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo enddo enddo -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- return end subroutine tridin -c----------------------------------------------------------------------- +!----------------------------------------------------------------------- !>\ingroup satmedmf !>\ingroup satmedmfvdifq !! This subroutine solves tridiagonal problem for TKE. From 3cdcdaab7261ffb212e0c36b6eeff34880429cb4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 11 May 2020 01:19:18 +0000 Subject: [PATCH 23/97] change 633.0 to 622.0_r8 --- physics/sfc_nst.f | 2 +- physics/sfc_ocean.F | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 8c7343519..857506686 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -363,7 +363,7 @@ subroutine sfc_nst_run & dwat = 2.11e-5_r8*(t1(i)/t0k)**1.94_r8 ! water vapor diffusivity dtmp = (one+3.309e-3_r8*(t1(i)-t0k)-1.44e-6_r8*(t1(i)-t0k) & * (t1(i)-t0k))*0.02411_r8/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0*le*qss(i)/(rd*t1(i)*t1(i)) + wetc = 622.0_r8*le*qss(i)/(rd*t1(i)*t1(i)) alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor tem = (1.0e3_r8 * rain(i) / rho_w) * alfac * cp_w qrain(i) = tem * (tsea-t1(i)+1.0e3_r8*(qss(i)-q0(i))*le/cp) diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index d937ddf49..bdd7ea6b0 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -149,6 +149,7 @@ subroutine sfc_ocean_run & ep(i) = evap(i) qsurf(i) = qss + gflux(i) = zero endif enddo ! From 4c08f739c121af21483e832cd29b4f3d34c9361e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 18 May 2020 21:00:06 -0400 Subject: [PATCH 24/97] updating nst model coupled with ocean model --- physics/module_nst_water_prop.f90 | 86 ++++++++++++++----------------- physics/sfc_nst.f | 34 ++++++------ 2 files changed, 55 insertions(+), 65 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 3f3916396..81e31b148 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -60,8 +60,8 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) tc = t - t0k - alpha = & - 6.793952e-2 & + alpha = & + 6.793952e-2 & - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & - 4.0899e-3 * s & @@ -73,7 +73,7 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) ! alpha = -alpha/rhoref - beta = & + beta = & 8.24493e-1 - 4.0899e-3 * tc & + 7.6438e-5 * tc**2 - 8.2467e-7 * tc**3 & + 5.3875e-9 * tc**4 - 1.5 * 5.72466e-3 * s**.5 & @@ -109,10 +109,10 @@ subroutine density(t, s, rho) ! effect of temperature on density (lines 1-3) ! effect of temperature and salinity on density (lines 4-8) - rho = & - 999.842594 + 6.793952e-2 * tc & - - 9.095290e-3 * tc**2 + 1.001685e-4 * tc**3 & - - 1.120083e-6 * tc**4 + 6.536332e-9 * tc**5 & + rho = & + 999.842594 + 6.793952e-2 * tc & + - 9.095290e-3 * tc**2 + 1.001685e-4 * tc**3 & + - 1.120083e-6 * tc**4 + 6.536332e-9 * tc**5 & + 8.24493e-1 * s - 4.0899e-3 * tc * s & + 7.6438e-5 * tc**2 * s - 8.2467e-7 * tc**3 * s & + 5.3875e-9 * tc**4 * s - 5.72466e-3 * s**1.5 & @@ -415,9 +415,9 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(out):: df_sol_z ! if(z>0) then - df_sol_z=f_sol_0*(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - +0.27*0.357*(1.-exp(-z/0.357)) & + df_sol_z=f_sol_0*(1.0 & + -(0.28*0.014*(1.-exp(-z/0.014)) & + +0.27*0.357*(1.-exp(-z/0.357)) & +.45*12.82*(1.-exp(-z/12.82)))/z & ) else @@ -444,9 +444,9 @@ elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) real(kind=kind_phys):: fxp ! if(z>0) then - fxp=(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - + 0.27*0.357*(1.-exp(-z/0.357)) & + fxp=(1.0 & + -(0.28*0.014*(1.-exp(-z/0.014)) & + + 0.27*0.357*(1.-exp(-z/0.357)) & + 0.45*12.82*(1.-exp(-z/12.82)))/z & ) aw=1.0-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) @@ -702,69 +702,59 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm ! Local variables integer :: i,j - real (kind=kind_phys), dimension(nx,ny) :: dtw,dtc - real (kind=kind_phys) :: dt_warm + real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi + real (kind=kind_phys), parameter :: zero=0.0, half=0.5, one=1.0 -!$omp parallel do private(j,i) +!$omp parallel do private(j,i,dtw,dtc,xzi) do j = 1, ny do i= 1, nx -! -! initialize dtw & dtc as zeros -! - dtw(i,j) = 0.0 - dtc(i,j) = 0.0 -! if ( wet(i,j) .and. .not.icy(i,j) ) then + + dtm(i,j) = zero ! initialize dtm + if ( wet(i,j) ) then ! ! get the mean warming in the range of z=z1 to z=z2 ! - if ( xt(i,j) > 0.0 ) then - dt_warm = (xt(i,j)+xt(i,j))/xz(i,j) ! Tw(0) - if ( z1 < z2) then + dtw = zero + if ( xt(i,j) > zero ) then + xzi = one / xz(i,j) + dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) + if (z1 < z2) then if ( z2 < xz(i,j) ) then - dtw(i,j) = dt_warm*(1.0-(z1+z2)/(xz(i,j)+xz(i,j))) - elseif ( z1 < xz(i,j) .and. z2 >= xz(i,j) ) then - dtw(i,j) = 0.5*(1.0-z1/xz(i,j))*dt_warm*(xz(i,j)-z1)/(z2-z1) + dtw = dt_warm * (one-half*(z1+z2)*xzi) + elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then + dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) endif - elseif ( z1 == z2 ) then - if ( z1 < xz(i,j) ) then - dtw(i,j) = dt_warm*(1.0-z1/xz(i,j)) + elseif (z1 == z2 ) then + if (z1 < xz(i,j) ) then + dtw = dt_warm * (one-z1*xzi) endif endif endif ! ! get the mean cooling in the range of z=0 to z=zsea ! - if ( zc(i,j) > 0.0 ) then + dtc = zero + if ( zc(i,j) > zero ) then if ( z1 < z2) then if ( z2 < zc(i,j) ) then - dtc(i,j) = dt_cool(i,j)*(1.0-(z1+z2)/(zc(i,j)+zc(i,j))) + dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then - dtc(i,j) = 0.5*(1.0-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) + dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < zc(i,j) ) then - dtc(i,j) = dt_cool(i,j)*(1.0-z1/zc(i,j)) + dtc = dt_cool(i,j) * (one-z1/zc(i,j)) endif endif endif - endif ! if ( wet(i,j) .and. .not.icy(i,j) ) then - enddo - enddo -! ! get the mean T departure from Tf in the range of z=z1 to z=z2 - -! DH* NEED NTHREADS HERE! TODO -!$omp parallel do private(j,i) - do j = 1, ny - do i= 1, nx -! if ( wet(i,j) .and. .not.icy(i,j)) then - if ( wet(i,j) ) then - dtm(i,j) = dtw(i,j) - dtc(i,j) - endif + dtm(i,j) = dtw - dtc + endif ! if ( wet(i,j)) then enddo enddo +! end subroutine get_dtzm_2d diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 857506686..6022d229f 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -682,6 +682,7 @@ subroutine sfc_nst_pre_run & z_c, tref, cplflx, oceanfrac, errmsg, errflg) use machine , only : kind_phys + use module_nst_water_prop, only: get_dtzm_2d implicit none @@ -707,8 +708,9 @@ subroutine sfc_nst_pre_run real(kind=kind_phys), parameter :: zero = 0.0_r8, & one = 1.0_r8, & half = 0.5_r8, - & omz1 = 10.0_r8 - real(kind=kind_phys) :: tem1, tem2, dt_warm + & omz1 = 2.0_r8 + real(kind=kind_phys) :: tem1, tem2, dt_warm, dnsst + real(kind=kind_phys), dimension(im) :: dtzm ! Initialize CCPP error handling variables errmsg = '' @@ -720,31 +722,30 @@ subroutine sfc_nst_pre_run ! DH* 20190927 simplyfing this code because tem is zero !tem = zero !tseal(i) = tsfc_ocn(i) + tem - tseal(i) = tsfc_ocn(i) + tseal(i) = tsfc_ocn(i) !tsurf_ocn(i) = tsurf_ocn(i) + tem ! *DH endif enddo +! +! update tsfc & tref with T1 from OGCM & NSST Profile if coupled +! if (cplflx) then - tem1 = half / omz1 + call get_dtzm_2d (xt, xz, dt_cool, & + & z_c, wet, zero, omz1, im, 1, dtzm) do i=1,im if (wet(i) .and. oceanfrac(i) > zero) then +! dnsst = tsfc_ocn(i) - tref(i) ! retrive/get difference of Ts and Tf + tref(i) = tsfc_ocn(i) - dtzm(i) ! update Tf with T1 and NSST T-Profile +! tsfc_ocn(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update +! tseal(i) = tsfc_ocn(i) if (abs(xz(i)) > zero) then tem2 = one / xz(i) else tem2 = zero endif - dt_warm = (xt(i)+xt(i)) * tem2 - if ( xz(i) > omz1) then - tref(i) = tseal(i) - (one-half*omz1*tem2) * dt_warm & - & + z_c(i)*dt_cool(i)*tem1 - else - tref(i) = tseal(i) - (xz(i)*dt_warm & - & - z_c(i)*dt_cool(i))*tem1 - endif - tseal(i) = tref(i) + dt_warm - dt_cool(i) -! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse + tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) tsurf_ocn(i) = tseal(i) endif enddo @@ -838,15 +839,14 @@ subroutine sfc_nst_post_run & ! --- ... run nsst model ... --- - dtzm = 0.0_r8 if (nstf_name1 > 1) then zsea1 = 0.001_r8*real(nstf_name4) zsea2 = 0.001_r8*real(nstf_name5) call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & & im, 1, dtzm) do i = 1, im -! if (wet(i) .and. .not.icy(i)) then -! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then +! if (wet(i) .and. .not.icy(i)) then +! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then if (wet(i)) then tsfc_ocn(i) = max(tgice, tref(i) + dtzm(i)) ! tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) - & From d810799b637173f14360bad7727ef9f05a0351ba Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 27 May 2020 20:16:24 -0400 Subject: [PATCH 25/97] some fix related to ice in surface cycling --- physics/gcycle.F90 | 30 ++++++++++++------------ physics/sfcsub.F | 57 ++++++++++++++++++++++++++-------------------- 2 files changed, 47 insertions(+), 40 deletions(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index ad627233b..f750f6769 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -84,22 +84,22 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) len = 0 do jx = Model%jsc, (Model%jsc+Model%ny-1) - do ix = Model%isc, (Model%isc+Model%nx-1) - len = len + 1 - i_index(len) = ix - j_index(len) = jx - enddo + do ix = Model%isc, (Model%isc+Model%nx-1) + len = len + 1 + i_index(len) = ix + j_index(len) = jx + enddo enddo - sig1t = 0.0 + sig1t = 0.0_kind_phys npts = Model%nx*Model%ny ! len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 - RLA (len) = Grid(nb)%xlat (ix) * pifac - RLO (len) = Grid(nb)%xlon (ix) * pifac + RLA (len) = Grid(nb)%xlat (ix) * pifac + RLO (len) = Grid(nb)%xlon (ix) * pifac OROG (len) = Sfcprop(nb)%oro (ix) OROG_UF (len) = Sfcprop(nb)%oro_uf (ix) SLIFCS (len) = Sfcprop(nb)%slmsk (ix) @@ -142,18 +142,18 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%slc (ix,ls) enddo - IF (SLIFCS(len) .LT. 0.1 .OR. SLIFCS(len) .GT. 1.5) THEN - SLMASK(len) = 0 + IF (SLIFCS(len) < 0.1_kind_phys .OR. SLIFCS(len) > 1.5_kind_phys) THEN + SLMASK(len) = 0.0_kind_phys ELSE - SLMASK(len) = 1 + SLMASK(len) = 1.0_kind_phys ENDIF - IF (SLIFCS(len) .EQ. 2) THEN - AISFCS(len) = 1. + IF (SLIFCS(len) > 1.99_kind_phys) THEN + AISFCS(len) = 1.0_kind_phys ELSE - AISFCS(len) = 0. + AISFCS(len) = 0.0_kind_phys ENDIF - if (Sfcprop(nb)%lakefrac(ix) > 0.0) then + if (Sfcprop(nb)%lakefrac(ix) > 0.0_kind_phys) then lake(len) = .true. else lake(len) = .false. diff --git a/physics/sfcsub.F b/physics/sfcsub.F index f9c3af1f7..ee4a2ec09 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -2416,7 +2416,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & do j = 1,lsoil do i = 1,len smcfcs(i,j) = smcanl(i,j) - if (slifcs(i) .gt. 0.0) then + if (slifcs(i) > 0.0_kind_io8) then stcfcs(i,j) = stcanl(i,j) else stcfcs(i,j) = tsffcs(i) @@ -2435,7 +2435,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points -! crit=aislim +! crit = aislim do i=1,len sihfcs(i) = sihanl(i) sitfcs(i) = tsffcs(i) @@ -2444,38 +2444,46 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & else crit = min_seaice endif - if (slifcs(i) >= 2.) then + if (slifcs(i) >= 1.99_kind_io8) then if (sicfcs(i) > crit) then - tem1 = 1.0 / sicfcs(i) + tem1 = 1.0_kind_io8 / sicfcs(i) tsffcs(i) = (sicanl(i)*tsffcs(i) & + (sicfcs(i)-sicanl(i))*tgice) * tem1 sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem1 + sicfcs(i) = sicanl(i) else tsffcs(i) = tsfanl(i) ! tsffcs(i) = tgice - sihfcs(i) = sihnew +! sihfcs(i) = sihnew + sihfcs(i) = 0.0_kind_io8 + sicfcs(i) = 0.0_kind_io8 + slifcs(i) = 0.0_kind_io8 endif endif - sicfcs(i) = sicanl(i) - enddo - do i=1,len - if (slifcs(i) < 1.5) then - sihfcs(i) = 0. - sicfcs(i) = 0. - sitfcs(i) = tsffcs(i) - else - if (lake(i)) then - crit = min_lakeice - else - crit = min_seaice - endif - if (sicfcs(i) < crit) then + if (slifcs(i) > 1.5_kind_io8 .and. sicfcs(i) < crit) then print *,'warning: check, slifcs and sicfcs', & & slifcs(i),sicfcs(i) - endif endif enddo +! do i=1,len +! if (slifcs(i) < 1.5_kind_io8) then +! sihfcs(i) = 0.0_kind_io8 +! sicfcs(i) = 0.0_kind_io8 +! sitfcs(i) = tsffcs(i) +! else +! if (lake(i)) then +! crit = min_lakeice +! else +! crit = min_seaice +! endif +! if (sicfcs(i) < crit) then +! print *,'warning: check, slifcs and sicfcs', & +! & slifcs(i),sicfcs(i) +! endif +! endif +! enddo + ! ! ensure the consistency between slc and smc ! @@ -7323,8 +7331,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & kpd7=-1 if (ialb == 1) then -!cbosu still need facsf and facwf. read them from the production -!cbosu file +!cbosu still need facsf and facwf. read them from the production file if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask &, alf,len,iret @@ -8133,8 +8140,7 @@ end subroutine clima !>\ingroup mod_sfcsub subroutine fixrdc_tile(filename_raw, tile_num_ch, & - & i_index, j_index, kpds, & - & var, mon, npts, me) + & i_index, j_index, kpds, var, mon, npts, me) use netcdf use machine , only : kind_io8 implicit none @@ -8151,7 +8157,8 @@ subroutine fixrdc_tile(filename_raw, tile_num_ch, & integer :: nx, ny, num_times integer :: id_var real(kind=4), allocatable :: dummy(:,:,:) - ii=index(filename_raw,"tileX") + + ii = index(filename_raw,"tileX") do i = 1, len(filename) filename(i:i) = " " From 8b77f369475e949bc1735c33e340a97d09f59c82 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 14 Jun 2020 23:52:12 +0000 Subject: [PATCH 26/97] updating sfc_diff.f to compute z0 overocean when ww3 sends z0 values <= 0.0 --- physics/sfc_diff.f | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 81aacc19a..53837cac5 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -356,15 +356,25 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) elseif (sfc_z0_type == 6) then ! wang call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0_r8 * z0 ! cm + z0rl_ocn(i) = 100.0_r8 * z0 ! cm elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0_r8 * z0 ! cm + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0_r8 * z0 ! cm else z0rl_ocn(i) = 1.0e-4_r8 endif + elseif (z0rl_ocn(i) <= 0.0_r8) then + z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + + if (redrag) then + z0rl_ocn(i) = 100.0_r8 * max(min(z0, z0s_max),1.0e-7_r8) + else + z0rl_ocn(i) = 100.0_r8 * max(min(z0,0.1_r8), 1.e-7_r8) + endif + endif + endif ! end of if(open ocean) ! endif ! end of if(flagiter) loop From 37444dc7da2af9399c17c1c9bd63b100ea0fd81c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 29 Jun 2020 23:38:57 +0000 Subject: [PATCH 27/97] updating sfc_diff.f to recompute z0 over ocean when coupled to ww3 and value is below 1.0e-7 --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 2a52b28c4..3ec69cd4f 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -355,13 +355,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_r8 endif - elseif (z0rl_wat(i) <= 0.0_r8) then + elseif (z0rl_wat(i) <= 1.0e-7_r8) then z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) if (redrag) then z0rl_wat(i) = 100.0_r8 * max(min(z0, z0s_max),1.0e-7_r8) else - z0rl_wat(i) = 100.0_r8 * max(min(z0,0.1_r8), 1.e-7_r8) + z0rl_wat(i) = 100.0_r8 * max(min(z0,0.1_r8), 1.0e-7_r8) endif endif From 3af3d7f9b1ae847662958ffbebba28e79ef23bf4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 8 Jul 2020 00:49:55 +0000 Subject: [PATCH 28/97] fixing errors/logic with fractional grid option to reproduce a continuous run from a restart run - works for both NEMS mediator and CMEPS --- physics/GFS_surface_composites.F90 | 65 +++++++++++++++++++++-------- physics/GFS_surface_composites.meta | 24 +++++++++-- physics/GFS_surface_generic.F90 | 1 + physics/gcycle.F90 | 11 ++--- physics/sfc_sice.f | 55 ++++++++++++++---------- physics/sfc_sice.meta | 64 ++++++++++++++-------------- 6 files changed, 142 insertions(+), 78 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index cb0b24320..96dc88949 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -26,7 +26,7 @@ end subroutine GFS_surface_composites_pre_finalize !! subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cplwav2atm, & landfrac, lakefrac, oceanfrac, & - frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_wat, & + frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorli, zorl_wat, & zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_wat, & weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, & @@ -47,7 +47,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl real(kind=kind_phys), dimension(im), intent( out) :: frland real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd - real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfc, tsfco, tsfcl, tisfc, tsurf + real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, zorli, tsfc, tsfco, tsfcl, tisfc, tsurf real(kind=kind_phys), dimension(im), intent(inout) :: snowd_wat, snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, zorl_wat, zorl_lnd, zorl_ice, tsfc_wat, tsfc_lnd, tsfc_ice, tsurf_wat, & tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, gflx_ice @@ -77,23 +77,31 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl if (flag_cice(i)) then if (cice(i) >= min_seaice) then icy(i) = .true. + if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists else - cice(i) = zero - flag_cice(i) = .false. - islmsk(i) = 0 + cice(i) = zero + flag_cice(i) = .false. +! islmsk_cice(i) = 0 +! islmsk(i) = 0 + wet(i) = .true. ! some open ocean/lake water exists endif else if (cice(i) >= min_lakeice) then icy(i) = .true. + if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists + islmsk(i) = 2 else cice(i) = zero - islmsk(i) = 0 +! islmsk(i) = 0 + wet(i) = .true. ! some open ocean/lake water exists endif endif - if (cice(i) < one ) then - wet(i) = .true. ! some open ocean/lake water exists - if ((.not. cplflx .or. oceanfrac(i) == zero) .and. icy(i)) & - tsfco(i) = max(tisfc(i), tgice) + if (wet(i) .and. .not. cplflx) then + if (oceanfrac(i) > zero) then + tsfco(i) = max(tsfco(i), tisfc(i), tgice) + elseif (icy(i)) then + tsfco(i) = max(tisfc(i), tgice) + endif endif else cice(i) = zero @@ -173,7 +181,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl if (icy(i)) then ! Ice uustar_ice(i) = uustar(i) weasd_ice(i) = weasd(i) - zorl_ice(i) = zorll(i) + zorl_ice(i) = zorli(i) tsfc_ice(i) = tisfc(i) tsurf_ice(i) = tisfc(i) snowd_ice(i) = snowd(i) @@ -296,7 +304,7 @@ end subroutine GFS_surface_composites_post_finalize #endif subroutine GFS_surface_composites_post_run ( & im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & - zorl, zorlo, zorll, zorl_wat, zorl_lnd, zorl_ice, & + zorl, zorlo, zorll, zorli, zorl_wat, zorl_lnd, zorl_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & @@ -319,7 +327,7 @@ subroutine GFS_surface_composites_post_run ( snowd_wat, snowd_lnd, snowd_ice,tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice - real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & + real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, zorli, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature @@ -361,7 +369,7 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) @@ -388,10 +396,30 @@ subroutine GFS_surface_composites_post_run ( tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) zorll(i) = zorl_lnd(i) + zorli(i) = zorl_ice(i) zorlo(i) = zorl_wat(i) - if (dry(i)) tsfcl(i) = tsfc_lnd(i) ! over land - if (wet(i)) tsfco(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + if (dry(i)) then + tsfcl(i) = tsfc_lnd(i) ! over land + elseif (wet(i)) then + tsfcl(i) = tsfc_wat(i) ! over water + else + tsfcl(i) = tice(i) ! over ice + endif + if (wet(i)) then + tsfco(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + elseif (icy(i)) then + tsfco(i) = tice(i) ! over lake or ocean ice when uncoupled + else + tsfco(i) = tsfc_lnd(i) ! over land + endif + if (icy(i)) then + tisfc(i) = tice(i) ! over lake or ocean ice when uncoupled + elseif (wet(i)) then + tisfc(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + else + tisfc(i) = tsfc_lnd(i) ! over land + endif ! for coupled model ocean will replace this ! if (icy(i)) tisfc(i) = tsfc_ice(i) ! over ice when uncoupled ! if (icy(i)) tisfc(i) = tice(i) ! over ice when uncoupled @@ -402,9 +430,9 @@ subroutine GFS_surface_composites_post_run ( ! endif if (.not. flag_cice(i)) then - if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) + else ! this would be over open ocean or land (no ice fraction) hice(i) = zero cice(i) = zero tisfc(i) = tsfc(i) @@ -530,6 +558,7 @@ subroutine GFS_surface_composites_post_run ( zorll(i) = zorl_lnd(i) zorlo(i) = zorl_wat(i) + zorli(i) = zorl_ice(i) enddo diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index f58eddc2f..0f9c065f3 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -162,6 +162,15 @@ kind = kind_phys intent = inout optional = F +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [zorl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) @@ -506,7 +515,7 @@ [min_lakeice] standard_name = lake_ice_minimum long_name = minimum lake ice value - units = ??? + units = frac dimensions = () type = real kind = kind_phys @@ -515,7 +524,7 @@ [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value - units = ??? + units = frac dimensions = () type = real kind = kind_phys @@ -829,6 +838,15 @@ kind = kind_phys intent = inout optional = F +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [zorl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) @@ -1669,7 +1687,7 @@ [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value - units = ??? + units = frac dimensions = () type = real kind = kind_phys diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index b05a84173..c7032866d 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -141,6 +141,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, do i=1,im sigmaf(i) = max(vfrac(i), 0.01_kind_phys) + islmsk_cice(i) = islmsk(i) if (islmsk(i) == 2) then if (isot == 1) then soiltyp(i) = 16 diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index bffcbefa5..f92ee8821 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -67,7 +67,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi real(kind=kind_phys) :: sig1t, dt_warm - integer :: npts, len, nb, ix, jx, ls, ios + integer :: npts, len, nb, ix, jx, ls, ios, ll logical :: exists ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@ -244,10 +244,11 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%alnsf (ix) = ALBFC1 (len + npts*2) Sfcprop(nb)%alnwf (ix) = ALBFC1 (len + npts*3) do ls = 1,Model%lsoil - Sfcprop(nb)%smc (ix,ls) = SMCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%stc (ix,ls) = STCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%slc (ix,ls) = SLCFC1 (len + (ls-1)*npts) - if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (len + (ls-1)*npts) + ll = len + (ls-1)*npts + Sfcprop(nb)%smc (ix,ls) = SMCFC1 (ll) + Sfcprop(nb)%stc (ix,ls) = STCFC1 (ll) + Sfcprop(nb)%slc (ix,ls) = SLCFC1 (ll) + if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (ll) enddo ENDDO !-----END BLOCK SIZE LOOP------------------------------ ENDDO !-----END BLOCK LOOP------------------------------- diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 7e55f7244..ab67f849e 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -43,11 +43,12 @@ subroutine sfc_sice_run & & ( im, kice, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: & t0c, rd, ps, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & - & cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, & - & flag_iter, lprnt, ipr, cimin, & + & cm, ch, prsl1, prslki, prsik1, prslk1, wind, & + & flag_iter, lprnt, ipr, & & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- input/outputs: & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! - & cplflx, cplchm, flag_cice, islmsk_cice, & + & frac_grid, icy, islmsk_cice, & + & min_lakeice, min_seaice, oceanfrac, & & errmsg, errflg & ) @@ -60,10 +61,10 @@ subroutine sfc_sice_run & ! inputs: ! ! ( im, kice, ps, t1, q1, delt, ! ! sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, ! -! cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, ! +! cm, ch, prsl1, prslki, prsik1, prslk1, wind, ! ! flag_iter, ! ! input/outputs: ! -! hice, fice, tice, weasd, tskin, tprcp, tiice, ep, ! +! hice, fice, tice, weasd, tskin, tprcp, tiice, ep, ! ! outputs: ! ! snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx ) ! ! ! @@ -151,21 +152,21 @@ subroutine sfc_sice_run & ! --- inputs: integer, intent(in) :: im, kice, ipr logical, intent(in) :: lprnt - logical, intent(in) :: cplflx - logical, intent(in) :: cplchm + logical, intent(in) :: frac_grid real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & & epsm1, grav, rvrdm1, t0c, rd real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & - & prsl1, prslki, prsik1, prslk1, wind + & prsl1, prslki, prsik1, prslk1, wind, oceanfrac - integer, dimension(im), intent(in) :: islimsk +! integer, dimension(im), intent(in) :: islimsk integer, dimension(im), intent(in) :: islmsk_cice - real (kind=kind_phys), intent(in) :: delt, cimin + real (kind=kind_phys), intent(in) :: delt, min_seaice, & + & min_lakeice - logical, dimension(im), intent(in) :: flag_iter, flag_cice + logical, dimension(im), intent(in) :: flag_iter, icy ! --- input/outputs: real (kind=kind_phys), dimension(im), intent(inout) :: hice, & @@ -189,7 +190,7 @@ subroutine sfc_sice_run & real (kind=kind_phys) :: t12, t14, tem, stsice(im,kice) &, hflxi, hflxw, q0, qs1, qssi, qssw - real (kind=kind_phys) :: cpinv, hvapi, elocp, snetw + real (kind=kind_phys) :: cpinv, hvapi, elocp, snetw, cimin integer :: i, k integer, dimension(im) :: islmsk_local @@ -207,15 +208,22 @@ subroutine sfc_sice_run & errflg = 0 - if (cplflx) then - where (flag_cice) - islmsk_local = islmsk_cice - elsewhere - islmsk_local = islimsk - endwhere - else - islmsk_local = islimsk - end if + islmsk_local = islmsk_cice + if (frac_grid) then + do i=1,im + if (icy(i) .and. islmsk_local(i) < 2) then + if (oceanfrac(i) > zero) then + tem = min_seaice + else + tem = min_lakeice + endif + if (fice(i) > tem) then + islmsk_local(i) = 2 + tice(i) =min( tice(i), tgice) + endif + endif + enddo + endif ! !> - Set flag for sea-ice. @@ -255,6 +263,11 @@ subroutine sfc_sice_run & do i = 1, im if (flag(i)) then + if (oceanfrac(i) > zero) then + cimin = min_seaice + else + cimin = min_lakeice + endif ! psurf(i) = 1000.0 * ps(i) ! ps1(i) = 1000.0 * prsl1(i) diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index dc08e0170..a05f2e4d6 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -242,14 +242,6 @@ kind = kind_phys intent = in optional = F -[islimsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -283,15 +275,6 @@ type = integer intent = in optional = F -[cimin] - standard_name = lake_ice_minimum - long_name = minimum lake ice value - units = ??? - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [hice] standard_name = sea_ice_thickness long_name = sea-ice thickness @@ -436,25 +419,17 @@ kind = kind_phys intent = inout optional = F -[cplflx] - standard_name = flag_for_flux_coupling - long_name = flag controlling cplflx collection (default off) +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid units = flag dimensions = () type = logical intent = in optional = F -[cplchm] - standard_name = flag_for_chemistry_coupling - long_name = flag controlling cplchm collection (default off) - units = flag - dimensions = () - type = logical - intent = in - optional = F -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction units = flag dimensions = (horizontal_dimension) type = logical @@ -468,6 +443,33 @@ type = integer intent = in optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From a60979041fd91fe4b942332d1e6efb1c009f44fe Mon Sep 17 00:00:00 2001 From: Michael Iacono Date: Fri, 17 Jul 2020 22:52:12 +0000 Subject: [PATCH 29/97] Update for new RRTMG cloud overlap methods EXP and ER --- physics/GFS_rrtmg_pre.F90 | 132 +++++++---- physics/GFS_rrtmg_pre.meta | 9 + physics/physcons.F90 | 3 + physics/physparam.f | 8 + physics/radiation_clouds.f | 468 ++++++++++++++++++++++++++++++++++--- physics/radlw_main.f | 145 ++++++++++-- physics/radlw_main.meta | 9 + physics/radsw_main.f | 150 ++++++++++-- physics/radsw_main.meta | 9 + 9 files changed, 811 insertions(+), 122 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index d0826eb17..e4e8c10b0 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -33,7 +33,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, & - mtopa, mbota, de_lgth, alb1d, errmsg, errflg) + mtopa, mbota, de_lgth, alpha, alb1d, errmsg, errflg) use machine, only: kind_phys use GFS_typedefs, only: GFS_statein_type, & @@ -146,6 +146,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota integer, dimension(size(Grid%xlon,1),3), intent(out) :: mtopa real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: alpha real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: alb1d character(len=*), intent(out) :: errmsg @@ -156,14 +157,14 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb - real(kind=kind_phys) :: es, qs, delt, tem0d + real(kind=kind_phys) :: es, qs, delt, tem0d, pfac real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & - cldcov, deltaq, cnvc, cnvw, & + dzb, hzb, cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs, rho, orho ! for Thompson MP real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & @@ -171,7 +172,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input qi_mp, qs_mp, nc_mp, ni_mp, nwfa real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db -! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 @@ -432,6 +433,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo ! --- ... level height and layer thickness (km) +! dz: Layer thickness between layer boundaries +! dzb: Layer thickness between layer centers (lowest is from surface to lowest layer center) +! hz: Height of each level (i.e. layer boundary) +! hzb: Height of each layer center tem0d = 0.001 * rog do i = 1, IM @@ -439,10 +444,20 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input dz(i,k) = tem0d * (tem2db(i,k+1) - tem2db(i,k)) * tvly(i,k) enddo -! hz(i,LMP) = 0.0 -! do k = LMK, 1, -1 -! hz(i,k) = hz(i,k+1) + dz(i,k) -! enddo + hz(i,LMP) = 0.0 + do k = LMK, 1, -1 + hz(i,k) = hz(i,k+1) + dz(i,k) + enddo + + do k = LMK, 1, -1 + pfac = (tem2db(i,k+1) - tem2da(i,k)) / (tem2db(i,k+1) - tem2db(i,k)) + hzb(i,k) = hz(i,k+1) + pfac * (hz(i,k) - hz(i,k+1)) + enddo + + do k = LMK-1, 1, -1 + dzb(i,k) = hzb(i,k) - hzb(i,k+1) + enddo + dzb(i,LMK) = hzb(i,LMK) - hz(i,LMP) enddo else ! input data from sfc to toa @@ -483,6 +498,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo ! --- ... level height and layer thickness (km) +! dz: Layer thickness between layer boundaries +! dzb: Layer thickness between layer centers (lowest is from surface to lowest layer center) +! hz: Height of each level (i.e. layer boundary) +! hzb: Height of each layer center tem0d = 0.001 * rog do i = 1, IM @@ -490,10 +509,20 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input dz(i,k) = tem0d * (tem2db(i,k) - tem2db(i,k+1)) * tvly(i,k) enddo -! hz(i,1) = 0.0 -! do k = 1, LMP -! hz(i,k+1) = hz(i,k) + dz(i,k) -! enddo + hz(i,1) = 0.0 + do k = 1, LMK + hz(i,k+1) = hz(i,k) + dz(i,k) + enddo + + do k = 1, LMK + pfac = (tem2db(i,k) - tem2da(i,k)) / (tem2db(i,k) - tem2db(i,k+1)) + hzb(i,k) = hz(i,k) + pfac * (hz(i,k+1) - hz(i,k)) + enddo + + do k = 2, LMK + dzb(i,k) = hzb(i,k) - hzb(i,k-1) + enddo + dzb(i,1) = hzb(i,1) - hz(i,1) enddo endif ! end_if_ivflip @@ -815,19 +844,21 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! or unified cloud and/or with MG microphysics if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & + IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + dzb, Grid%xlat_d, Model%julian, Model%yearlen, & + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs else - call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs - ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & - Sfcprop%slmsk, dz, delp, IM, LMK, LMP, & - Model%uni_cld, Model%lmfshal, & - Model%lmfdeep2, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs + ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & + Sfcprop%slmsk, dz, delp, IM, LMK, LMP, & + Model%uni_cld, Model%lmfshal, & + Model%lmfdeep2, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + dzb, Grid%xlat_d, Model%julian, Model%yearlen, & + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs endif elseif(Model%imp_physics == 98) then ! zhao/moorthi's prognostic cloud+pdfcld @@ -837,7 +868,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cnvw, cnvc, Grid%xlat, Grid%xlon, & Sfcprop%slmsk, dz, delp, im, lmk, lmp, deltaq, & Model%sup, Model%kdt, me, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + dzb, Grid%xlat_d, Model%julian, Model%yearlen, & + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs elseif (Model%imp_physics == 11) then ! GFDL cloud scheme @@ -847,21 +879,24 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(1:IM,1:LMK,1), cnvw, cnvc, & Grid%xlat, Grid%xlon, Sfcprop%slmsk, & cldcov, dz, delp, im, lmk, lmp, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + dzb, Grid%xlat_d, Model%julian, Model%yearlen, & + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs else call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & IM, LMK, LMP, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + dzb, Grid%xlat_d, Model%julian, Model%yearlen,& + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs ! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, & ! dz, delp, & ! ntrac-1, Model%ntcw-1,Model%ntiw-1,Model%ntrw-1,& ! Model%ntsw-1,Model%ntgl-1,Model%ntclamt-1, & ! im, lmk, lmp, & -! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs +! dzb, Grid%xlat_d, Model%julian, Model%yearlen, & +! clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs endif elseif(Model%imp_physics == 6 .or. Model%imp_physics == 15) then @@ -871,15 +906,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,Model%nseffr) = 250. endif - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + dzb, Grid%xlat_d, Model%julian, Model%yearlen,& + clouds,cldsa,mtopa,mbota, de_lgth, alpha) ! --- outputs elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP @@ -900,19 +936,21 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & IM, LMK, LMP, clouds(:,1:LMK,1), & effrl, effri, effrr, effrs, Model%effr_in , & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + dzb, Grid%xlat_d, Model%julian, Model%yearlen, & + clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs else ! MYNN PBL or GF convective are not used - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + dzb, Grid%xlat_d, Model%julian, Model%yearlen,& + clouds,cldsa,mtopa,mbota, de_lgth, alpha) ! --- outputs endif ! MYNN PBL or GF endif ! end if_imp_physics diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index a06e718a5..b46272605 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -554,6 +554,15 @@ kind = kind_phys intent = out optional = F +[alpha] + standard_name = cloud_overlap_decorrelation_parameter + long_name = cloud overlap decorrelation parameter + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F [alb1d] standard_name = surface_albedo_perturbation long_name = surface albedo perturbation diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 5fb993ac3..8fbdc9930 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -137,6 +137,9 @@ module physcons real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) +! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 + real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys + !........................................! end module physcons ! !========================================! diff --git a/physics/physparam.f b/physics/physparam.f index 795cb4fab..c71b62e5b 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -234,6 +234,8 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW @@ -241,8 +243,14 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 +!!\n Decorrelation length type for iovrlw/iovrsw = 4 or 5 +!!\n =0:use constant decorrelation length defined by decorr_con (in module physcons) +!!\n =1:use day-of-year and latitude-varying decorrelation length + integer, save :: idcor = 1 !> sub-column cloud approx flag in SW radiation !!\n =0:no McICA approximation in SW radiation diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 5b4aa54ab..9b0f34ef7 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -25,16 +25,18 @@ ! IX, NLAY, NLP1, ! ! uni_cld, lmfshal, lmfdeep2, cldcov, ! ! effrl,effri,effrr,effrs,effr_in, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! 'progcld2' --- ferrier prognostic cloud microphysics ! ! inputs: ! ! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, ! ! xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, ! ! IX, NLAY, NLP1, lmfshal, lmfdeep2, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! 'progcld3' --- zhao/moorthi prognostic cloud + pdfcld! ! inputs: ! @@ -42,16 +44,18 @@ ! xlat,xlon,slmsk, dz, delp, ! ! ix, nlay, nlp1, ! ! deltaq,sup,kdt,me, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! 'progcld4' --- gfdl-lin cloud microphysics ! ! inputs: ! ! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, ! ! xlat,xlon,slmsk, dz, delp, ! ! ix, nlay, nlp1, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! 'progcld4o' --- inactive ! ! ! @@ -63,16 +67,18 @@ ! ix, nlay, nlp1, ! ! uni_cld, lmfshal, lmfdeep2, cldcov, ! ! re_cloud,re_ice,re_snow, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! 'progclduni' --- for unified clouds with MG microphys! ! inputs: ! ! (plyr,plvl,tlyr,tvly,ccnd,ncnd, ! ! xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, ! ! effrl,effri,effrr,effrs,effr_in, ! +! dzlay, latdeg, julian, yearlen, ! ! outputs: ! -! clouds,clds,mtop,mbot,de_lgth) ! +! clouds,clds,mtop,mbot,de_lgth,alpha) ! ! ! ! internal accessable only subroutines: ! ! 'gethml' --- get diagnostic hi, mid, low clouds ! @@ -154,6 +160,10 @@ ! 'diagcld1' for diagnostic cloud scheme, added new cloud ! ! overlapping method of de-correlation length, and optimized ! ! the code structure. ! +! jul 2020, m.j. iacono - added rrtmg/mcica cloud overlap options ! +! exponential and exponential-random. each method can use ! +! either a constant or a latitude-varying and day-of-year ! +! varying decorrelation length selected with parameter "idcor". ! ! ! !!!!! ========================================================== !!!!! !!!!! end descriptions !!!!! @@ -181,6 +191,10 @@ !! Cloud overlapping method (namelist control parameter - \b IOVR_LW, \b IOVR_SW) !!\n IOVR=0: randomly overlapping vertical cloud layers !!\n IOVR=1: maximum-random overlapping vertical cloud layers +!!\n IOVR=2: maximum overlapping vertical cloud layers +!!\n IOVR=3: decorrelation length overlapping vertical cloud layers +!!\n IOVR=4: exponential overlapping vertical cloud layers +!!\n IOVR=5: exponential-random overlapping vertical cloud layers !! !! Sub-grid cloud approximation (namelist control parameter - \b ISUBC_LW=2, \b ISUBC_SW=2) !!\n ISUBC=0: grid averaged quantities, without sub-grid cloud approximation @@ -243,7 +257,7 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o, gethml + & cld_init, progcld5, progcld4o, gethml, get_alpha ! ================= @@ -302,6 +316,8 @@ subroutine cld_init & ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! ! =3: decorrelation-length overlap (mcica only) ! +! =4: exponential cloud overlap (AER; mcica only) ! +! =5: exponential-random overlap (AER; mcica only) ! ! ivflip : control flag for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -417,6 +433,10 @@ end subroutine cld_init !!\param effrr effective radius for rain water !!\param effrs effective radius for snow water !!\param effr_in logical, if .true. use input effective radii +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path \f$(g/m^2)\f$ @@ -430,7 +450,8 @@ end subroutine cld_init !!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases -!!\param de_lgth (IX), clouds decorrelation length (km) +!!\param de_lgth (IX), clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld1 progcld1 General Algorithm !> @{ subroutine progcld1 & @@ -438,7 +459,8 @@ subroutine progcld1 & & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & effrl,effri,effrr,effrs,effr_in, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -485,6 +507,10 @@ subroutine progcld1 & ! lmfshal : logical - true for mass flux shallow convection ! ! lmfdeep2 : logical - true for mass flux deep convection ! ! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -502,6 +528,7 @@ subroutine progcld1 & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -527,16 +554,21 @@ subroutine progcld1 & real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, cldcov, delp, dz, & - & effrl, effri, effrr, effrs + & effrl, effri, effrr, effrs, dzlay real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -804,6 +836,16 @@ subroutine progcld1 & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, !! and high clouds. The three cloud domain boundaries are defined by @@ -811,7 +853,7 @@ subroutine progcld1 & !! 'iovr', which may be different for lw and sw radiation programs. call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -850,6 +892,10 @@ end subroutine progcld1 !!\param NLAY,NLP1 vertical layer/level dimensions !!\param lmfshal flag for mass-flux shallow convection scheme in the cloud fraction calculation !!\param lmfdeep2 flag for mass-flux deep convection scheme in the cloud fraction calculation +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path \f$(g/m^2)\f$ @@ -864,13 +910,15 @@ end subroutine progcld1 !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases !!\param de_lgth (IX), clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld2 progcld2 General Algorithm !> @{ subroutine progcld2 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & & IX, NLAY, NLP1, lmfshal, lmfdeep2, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -917,6 +965,10 @@ subroutine progcld2 & ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -934,6 +986,7 @@ subroutine progcld2 & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! external module variables: ! ! ivflip : control flag of vertical index direction ! @@ -964,17 +1017,22 @@ subroutine progcld2 & real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, f_ice, f_rain, r_rime, & - & dz, delp + & dz, delp, dzlay real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk real (kind=kind_phys), dimension(:), intent(in) :: flgmin + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -1250,6 +1308,16 @@ subroutine progcld2 & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml(), to compute low, mid, high, total, and boundary !! layer cloud fractions and clouds top/bottom layer indices for low, !! mid, and high clouds. @@ -1259,7 +1327,7 @@ subroutine progcld2 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -1298,6 +1366,10 @@ end subroutine progcld2 !!\param sup supersaturation !!\param kdt !!\param me print control flag +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !!\param clouds (ix,nlay,nf_clds), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path (g/m**2) @@ -1312,6 +1384,7 @@ end subroutine progcld2 !!\param mtop (ix,3), vertical indices for low, mid, hi cloud tops !!\param mbot (ix,3), vertical indices for low, mid, hi cloud bases !!\param de_lgth (ix), clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld3 progcld3 General Algorithm !! @{ subroutine progcld3 & @@ -1319,7 +1392,8 @@ subroutine progcld3 & & xlat,xlon,slmsk, dz, delp, & & ix, nlay, nlp1, & & deltaq,sup,kdt,me, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -1366,6 +1440,10 @@ subroutine progcld3 & ! cnvc (ix,nlay) : layer convective cloud cover ! ! deltaq(ix,nlay) : half total water distribution width ! ! sup : supersaturation ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! @@ -1384,6 +1462,7 @@ subroutine progcld3 & ! mtop (ix,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (ix,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1404,7 +1483,7 @@ subroutine progcld3 & integer, intent(in) :: ix, nlay, nlp1,kdt real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp + & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp, dzlay ! & tlyr, tvly, qlyr, qstl, rhly, clw, cnvw, cnvc ! real (kind=kind_phys), dimension(:,:), intent(in) :: deltaq real (kind=kind_phys), dimension(:,:) :: deltaq, cnvw, cnvc @@ -1416,11 +1495,16 @@ subroutine progcld3 & & slmsk integer :: me + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -1647,6 +1731,16 @@ subroutine progcld3 & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> -# Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, !! and high clouds. @@ -1657,7 +1751,7 @@ subroutine progcld3 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & ix,nlay, & ! --- outputs: & clds, mtop, mbot & @@ -1696,6 +1790,10 @@ end subroutine progcld3 !!\param ix horizontal dimension !!\param nlay vertical layer dimension !!\param nlp1 vertical level dimension +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !!\param clouds (ix,nlay,nf_clds), cloud profiles !!\n clouds(:,:,1) - layer total cloud fraction !!\n clouds(:,:,2) - layer cloud liquid water path (\f$g m^{-2}\f$) @@ -1710,13 +1808,15 @@ end subroutine progcld3 !!\param mtop vertical indices for low, mid, hi cloud tops !!\param mbot vertical indices for low, mid, hi cloud bases !!\param de_lgth clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld4 progcld4 General Algorithm !! @{ subroutine progcld4 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: & xlat,xlon,slmsk,cldtot, dz, delp, & & IX, NLAY, NLP1, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -1761,6 +1861,10 @@ subroutine progcld4 & ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -1778,6 +1882,7 @@ subroutine progcld4 & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1800,16 +1905,21 @@ subroutine progcld4 & real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, cldtot, cnvw, cnvc, & - & delp, dz + & delp, dz, dzlay real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -1984,6 +2094,16 @@ subroutine progcld4 & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + ! --- compute low, mid, high, total, and boundary layer cloud fractions ! and clouds top/bottom layer indices for low, mid, and high clouds. ! The three cloud domain boundaries are defined by ptopc. The cloud @@ -1992,7 +2112,7 @@ subroutine progcld4 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2036,6 +2156,10 @@ end subroutine progcld4 !>\param ix horizontal dimension !>\param nlay vertical layer dimension !>\param nlp1 vertical level dimension +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !>\param clouds (ix,nlay,nf_clds), cloud profiles !!\n clouds(:,:,1) - layer totoal cloud fraction !!\n clouds(:,:,2) - layer cloud liquid water path (\f$g m^{-2}\f$) @@ -2050,6 +2174,7 @@ end subroutine progcld4 !>\param mtop (ix,3), vertical indices for low, mid, hi cloud tops !>\param mbot (ix,3), vertical indices for low, mid, hi cloud bases !>\param de_lgth clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld4o progcld4o General Algorithm !! @{ subroutine progcld4o & @@ -2057,7 +2182,8 @@ subroutine progcld4o & & xlat,xlon,slmsk, dz, delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntclamt, & & IX, NLAY, NLP1, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2101,6 +2227,10 @@ subroutine progcld4o & ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -2118,6 +2248,7 @@ subroutine progcld4o & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2141,18 +2272,23 @@ subroutine progcld4o & & ntclamt real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, delp, dz + & tlyr, tvly, qlyr, qstl, rhly, delp, dz, dzlay real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -2312,6 +2448,16 @@ subroutine progcld4o & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml() to compute low, mid, high, total, and boundary layer cloud fractions !! and clouds top/bottom layer indices for low, mid, and high clouds. !! The three cloud domain boundaries are defined by ptopc. The cloud @@ -2320,7 +2466,7 @@ subroutine progcld4o & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2345,7 +2491,8 @@ subroutine progcld5 & & IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2392,6 +2539,10 @@ subroutine progcld5 & ! lmfshal : logical - true for mass flux shallow convection ! ! lmfdeep2 : logical - true for mass flux deep convection ! ! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -2409,6 +2560,7 @@ subroutine progcld5 & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2434,7 +2586,7 @@ subroutine progcld5 & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & + & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & & re_cloud, re_ice, re_snow real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -2442,11 +2594,16 @@ subroutine progcld5 & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha integer, dimension(:,:), intent(out) :: mtop,mbot @@ -2659,6 +2816,16 @@ subroutine progcld5 & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, !! and high clouds. @@ -2670,7 +2837,7 @@ subroutine progcld5 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2706,6 +2873,10 @@ end subroutine progcld5 !!\param effrr (IX,NLAY), effective radius for rain water !!\param effrs (IX,NLAY), effective radius for snow water !!\param effr_in logical - if .true. use input effective radii +!!\param dzlay(ix,nlay) distance between model layer centers +!!\param latdeg(ix) latitude (in degrees 90 -> -90) +!!\param julian day of the year (fractional julian day) +!!\param yearlen current length of the year (365/366 days) !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path \f$(g/m^2)\f$ @@ -2720,13 +2891,15 @@ end subroutine progcld5 !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases !!\param de_lgth (IX), clouds decorrelation length (km) +!!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progclduni progclduni General Algorithm !> @{ subroutine progclduni & & ( plyr,plvl,tlyr,tvly,ccnd,ncnd, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, & & effrl,effri,effrr,effrs,effr_in, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2774,6 +2947,10 @@ subroutine progclduni & ! effr_in : logical - if .true. use input effective radii ! ! dz (ix,nlay) : layer thickness (km) ! ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! +! dzlay(ix,nlay) : thickness between model layer centers (km) ! +! latdeg(ix) : latitude (in degrees 90 -> -90) ! +! julian : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -2791,6 +2968,7 @@ subroutine progclduni & ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2815,11 +2993,16 @@ subroutine progclduni & real (kind=kind_phys), dimension(:,:,:), intent(in) :: ccnd real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr,& - & tlyr, tvly, cldtot, effrl, effri, effrr, effrs, dz, delp + & tlyr, tvly, cldtot, effrl, effri, effrr, effrs, dz, delp, & + & dzlay real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds @@ -2827,6 +3010,8 @@ subroutine progclduni & real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha + integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: @@ -3026,6 +3211,16 @@ subroutine progclduni & enddo endif +!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, !! and high clouds. @@ -3037,7 +3232,7 @@ subroutine progclduni & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -3064,6 +3259,7 @@ end subroutine progclduni !> \param cldcnv (IX,NLAY), convective cloud (for diagnostic scheme only) !> \param dz (IX,NLAY), layer thickness (km) !> \param de_lgth (IX), clouds decorrelation length (km) +!> \param alpha (IX,NLAY), alpha decorrelation parameter !> \param IX horizontal dimension !> \param NLAY vertical layer dimensions !> \param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl @@ -3073,7 +3269,7 @@ end subroutine progclduni !>\section detail Detailed Algorithm !! @{ subroutine gethml & - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & ! --- inputs: & IX, NLAY, & & clds, mtop, mbot & ! --- outputs: & ) @@ -3105,6 +3301,7 @@ subroutine gethml & ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! ! dz (ix,nlay) : layer thickness (km) ! ! de_lgth(ix) : clouds vertical de-correlation length (km) ! +! alpha(ix,nlay) : alpha decorrelation parameter ! IX : horizontal dimention ! ! NLAY : vertical layer dimensions ! ! ! @@ -3124,6 +3321,8 @@ subroutine gethml & ! =1 max/ran overlapping clouds ! ! =2 maximum overlapping ( for mcica only ) ! ! =3 decorr-length ovlp ( for mcica only ) ! +! =4: exponential cloud overlap (AER; mcica only) ! +! =5: exponential-random overlap (AER; mcica only) ! ! ! ! ==================== end of description ===================== ! ! @@ -3135,6 +3334,7 @@ subroutine gethml & real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & & cldtot, cldcnv, dz real (kind=kind_phys), dimension(:), intent(in) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(in) :: alpha ! --- outputs real (kind=kind_phys), dimension(:,:), intent(out) :: clds @@ -3270,6 +3470,33 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo + elseif ( iovr == 4 .or. iovr == 5 ) then ! exponential overlap (iovr=4), or + ! exponential-random (iovr=5); + ! distinction defined by alpha + + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = alpha(i,k) * min(cl2(i), (1.0 - ccur)) & ! maximum part + & + (1.0 - alpha(i,k)) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif + enddo + + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + endif ! end_if_iovr ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions @@ -3452,6 +3679,187 @@ end subroutine gethml !----------------------------------- !! @} +!> \ingroup module_radiation_clouds +!! This program derives the exponential transition, alpha, from maximum to +!! random overlap needed to define the fractional cloud vertical correlation +!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) +!! cloud overlap options for RRTMG. For exponential, the transition from +!! maximum to random with distance through model layers occurs without regard +!! to the configuration of clear and cloudy layers. For the ER method, each +!! block of adjacent cloudy layers is treated with a separate transition from +!! maximum to random, and blocks of cloudy layers separated by one or more +!! clear layers are correlated randomly. +!> /param nlon : number of model longitude points +!> /param nlay : vertical layer dimension +!> /param dzlay(nlon,nlay) : distance between the center of model layers +!> /param iovrlp : cloud overlap method +!> : 0 = random +!> : 1 = maximum-random +!> : 2 = maximum +!> : 3 = decorrelation (NOAA/Hou) +!> : 4 = exponential (AER) +!> : 5 = exponential-random (AER) +!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) +!> /param juldat : day of the year (fractional julian day) +!> /param yearlen : current length of the year (365/366 days) +!> /param cldf(nlon,nlay) : cloud fraction +!> /param idcor : decorrelation length method +!> : 0 = constant value (AER; decorr_con) +!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) +!> /param decorr_con : decorrelation length constant +!! +!>\section detail Detailed Algorithm +!! @{ + subroutine get_alpha & +! --- inputs: + & (nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cldf, & +! --- outputs: + & alpha & + & ) + +! =================================================================== ! +! ! +! abstract: Derives the exponential transition, alpha, from maximum to ! +! random overlap needed to define the fractional cloud vertical ! +! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! +! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! +! exponential, the transition from maximum to random with distance ! +! through model layers occurs without regard to the configuration of ! +! clear and cloudy layers. For the ER method, each block of adjacent ! +! cloudy layers is treated with a separate transition from maximum to ! +! random, and blocks of cloudy layers separated by one or more ! +! clear layers are correlated randomly. ! +! ! +! usage: call get_alpha ! +! ! +! subprograms called: none ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! author: m.j. iacono (AER) for use with the RRTMG radiation code ! +! ! +! ==================== definition of variables ==================== ! +! ! +! Input variables: ! +! nlon : number of model longitude points ! +! nlay : vertical layer dimension ! +! dzlay(nlon,nlay) : distance between the center of model layers ! +! iovrlp : cloud overlap method ! +! : 0 = random ! +! : 1 = maximum-random ! +! : 2 = maximum ! +! : 3 = decorrelation (NOAA/Hou) ! +! : 4 = exponential (AER) ! +! : 5 = exponential-random (AER) ! +! latdeg(nlon) : latitude (in degrees 90 -> -90) ! +! juldat : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! +! cldf(nlon,nlay) : cloud fraction ! +! ! +! output variables: ! +! alpha(nlon,nlay) : alpha exponential transition parameter for ! +! : cloud vertical correlation ! +! ! +! external module variables: (in physcons) ! +! decorr_con : decorrelation length constant (km) ! +! ! +! external module variables: (in physparam) ! +! idcor : control flag for decorrelation length method ! +! =0: constant decorrelation length (decorr_con) ! +! =1: latitude and day-of-year varying decorrelation! +! length (AER; Oreopoulos, et al., 2012) ! +! ! +! ==================== end of description ===================== ! +! + use physcons, only: decorr_con + use physparam, only: idcor + + implicit none + +! Input + integer, intent(in) :: nlon, nlay + integer, intent(in) :: iovrlp + integer, intent(in) :: yearlen + real(kind=kind_phys), dimension(:,:), intent(in) :: dzlay + real(kind=kind_phys), dimension(:,:), intent(in) :: cldf + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: juldat + +! Output + real(kind=kind_phys), dimension(:,:), intent(out):: alpha + +! Local + integer :: i, k + real(kind=kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) + +! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) +! Used when idcor = 1 + real(kind=kind_phys), parameter :: am1 = 1.4315_kind_phys + real(kind=kind_phys), parameter :: am2 = 2.1219_kind_phys + real(kind=kind_phys), parameter :: am4 = -25.584_kind_phys + real(kind=kind_phys), parameter :: amr = 7.0_kind_phys + real(kind=kind_phys) :: am3 + + real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: one = 1.0d0 + +! +!===> ... begin here +! +! If exponential or exponential-random cloud overlap is used: +! derive day-of-year and latitude-varying decorrelation lendth if requested; +! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 + do i = 1, nlon + if (iovrlp == 4 .or. iovrlp == 5) then + if (idcor .eq. 1) then + if (juldat .gt. 181._kind_phys) then + am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) + & / yearlen + else + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) + & / yearlen + endif +! For latitude in degrees, decorr_len in km + decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 + & / am4**2) + else + decorr_len(i) = decorr_con + endif + endif + enddo + +! For atmospheric data defined from surface to toa; define alpha from surface to toa +! Exponential cloud overlap + if (iovrlp == 4) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + enddo + enddo + endif +! Exponential-random cloud overlap + if (iovrlp == 5) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then + alpha(i,k) = zero + endif + enddo + enddo + endif + + return + + end subroutine get_alpha +!----------------------------------- +!! @} ! !........................................! end module module_radiation_clouds ! diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 7b029f8b0..cdcb91b48 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -6,7 +6,7 @@ !!!!! lw-rrtm3 radiation package description !!!!! !!!!! ============================================================== !!!!! ! ! -! this package includes ncep's modifications of the rrtm-lw radiation ! +! this package includes ncep's modifications of the rrtmg-lw radiation ! ! code from aer inc. ! ! ! ! the lw-rrtm3 package includes these parts: ! @@ -39,7 +39,7 @@ ! inputs: ! ! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! ! clouds,icseed,aerosols,sfemis,sfgtmp, ! -! dzlyr,delpin,de_lgth, ! +! dzlyr,delpin,de_lgth,alpha, ! ! npts, nlay, nlp1, lprnt, ! ! outputs: ! ! hlwc,topflx,sfcflx,cldtau, ! @@ -93,17 +93,38 @@ ! ! !==========================================================================! ! ! -! the original aer's program declarations: ! +! the original aer program declarations: ! ! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! | -! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | -! This software may be used, copied, or redistributed as long as it is | -! not sold and this copyright notice is reproduced on each copy made. | -! This model is provided as is without any express or implied warranties. | -! (http://www.rtweb.aer.com/) | -! | -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! Copyright (c) 2002-2020, Atmospheric & Environmental Research, Inc. (AER) ! +! All rights reserved. ! +! ! +! Redistribution and use in source and binary forms, with or without ! +! modification, are permitted provided that the following conditions are met: ! +! * Redistributions of source code must retain the above copyright ! +! notice, this list of conditions and the following disclaimer. ! +! * Redistributions in binary form must reproduce the above copyright ! +! notice, this list of conditions and the following disclaimer in the ! +! documentation and/or other materials provided with the distribution. ! +! * Neither the name of Atmospheric & Environmental Research, Inc., nor ! +! the names of its contributors may be used to endorse or promote products ! +! derived from this software without specific prior written permission. ! +! ! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" ! +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ! +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ! +! ARE DISCLAIMED. IN NO EVENT SHALL ATMOSPHERIC & ENVIRONMENTAL RESEARCH, INC.,! +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ! +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ! +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ! +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN ! +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF ! +! THE POSSIBILITY OF SUCH DAMAGE. ! +! (http://www.rtweb.aer.com/) ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ! ************************************************************************ ! ! ! @@ -136,8 +157,14 @@ ! ************************************************************************ ! ! ! ! references: ! -! (rrtm_lw/rrtmg_lw): ! -! clough, s.A., m.w. shephard, e.j. mlawer, j.s. delamere, ! +! (rrtmg_lw/rrtm_lw): ! +! iacono, m.j., j.s. delamere, e.j. mlawer, m.w. shepard, ! +! s.a. clough, and w.d collins, radiative forcing by long-lived ! +! greenhouse gases: calculations with the aer radiative transfer ! +! models, j, geophys. res., 113, d13103, doi:10.1029/2008jd009944, ! +! 2008. ! +! ! +! clough, s.a., m.w. shephard, e.j. mlawer, j.s. delamere, ! ! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! ! atmospheric radiative transfer modeling: a summary of the aer ! ! codes, j. quant. spectrosc. radiat. transfer, 91, 233-244, 2005. ! @@ -234,12 +261,21 @@ ! jun 2018, h-m lin/y-t hou -- added new option of cloud overlap ! ! method 'de-correlation-length' for mcica application ! ! ! +! ************************************************************************ ! +! ! +! additional aer revision history: ! +! jul 2020, m.j. iacono -- added new mcica cloud overlap options ! +! exponential and exponential-random. each method can ! +! use either a constant or a latitude-varying and ! +! day-of-year varying decorrelation length selected ! +! with parameter "idcor". ! +! ! !!!!! ============================================================== !!!!! !!!!! end descriptions !!!!! !!!!! ============================================================== !!!!! !> This module contains the CCPP-compliant NCEP's modifications of the -!! rrtm-lw radiation code from aer inc. +!! rrtmg-lw radiation code from aer inc. module rrtmg_lw ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & @@ -360,7 +396,7 @@ end subroutine rrtmg_lw_init !! \brief This module includes NCEP's modifications of the RRTMG-LW radiation !! code from AER. !! -!! The RRTM-LW package includes three files: +!! The RRTMG-LW package includes three files: !! - radlw_param.f, which contains: !! - module_radlw_parameters: band parameters set up !! - radlw_datatb.f, which contains modules: @@ -389,7 +425,7 @@ subroutine rrtmg_lw_run & & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & & icseed,aeraod,aerssa,sfemis,sfgtmp, & - & dzlyr,delpin,de_lgth, & + & dzlyr,delpin,de_lgth,alpha, & & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & & hlwc,topflx,sfcflx,cldtau, & ! --- outputs & HLW0,HLWB,FLXPRF, & ! --- optional @@ -444,6 +480,7 @@ subroutine rrtmg_lw_run & ! dzlyr(npts,nlay) : layer thickness (km) ! ! delpin(npts,nlay): layer pressure thickness (mb) ! ! de_lgth(npts) : cloud decorrelation length (km) ! +! alpha(npts,nlay) : EXP/ER cloud overlap decorrelation parameter ! ! npts : total number of horizontal points ! ! nlay, nlp1 : total number of vertical layers, levels ! ! lprnt : cntl flag for diagnostic print out ! @@ -492,6 +529,8 @@ subroutine rrtmg_lw_run & ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (used for isubclw>0 only) ! ! =3: decorrelation-length overlap (for isubclw>0 only) ! +! =4: exponential cloud overlap (AER) ! +! =5: exponential-random cloud overlap (AER) ! ! ivflip - control flag for vertical index direction ! ! =0: vertical index from toa to surface ! ! =1: vertical index from surface to toa ! @@ -589,6 +628,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & & sfgtmp, de_lgth + real (kind=kind_phys), dimension(npts,nlay), intent(in) :: alpha real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & & aeraod, aerssa @@ -650,6 +690,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys) :: tem0, tem1, tem2, pwvcm, summol, stemp, & & delgth + real (kind=kind_phys), dimension(nlay) :: alph integer, dimension(npts) :: ipseed integer, dimension(nlay) :: jp, jt, jt1, indself, indfor, indminor @@ -756,6 +797,7 @@ subroutine rrtmg_lw_run & tavel(k)= tlyr(iplon,k1) tz(k) = tlvl(iplon,k1) dz(k) = dzlyr(iplon,k1) + if (iovrlw == 4 .or. iovrlw == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation !> -# Set absorber amount for h2o, co2, and o3. @@ -868,6 +910,7 @@ subroutine rrtmg_lw_run & tavel(k)= tlyr(iplon,k) tz(k) = tlvl(iplon,k+1) dz(k) = dzlyr(iplon,k) + if (iovrlw == 4 .or. iovrlw == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation ! --- ... set absorber amount !test use @@ -1017,7 +1060,7 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), dz, delgth, & + & nlay, nlp1, ipseed(iplon), dz, delgth, alph, & ! --- outputs: & cldfmc, taucld & & ) @@ -1344,7 +1387,7 @@ subroutine rlwinit & ! !===> ... begin here ! - if ( iovrlw<0 .or. iovrlw>3 ) then + if ( iovrlw<0 .or. iovrlw>5 ) then print *,' *** Error in specification of cloud overlap flag', & & ' IOVRLW=',iovrlw,' in RLWINIT !!' stop @@ -1486,13 +1529,14 @@ end subroutine rlwinit !!\param ipseed permutation seed for generating random numbers (isubclw>0) !!\param dz layer thickness (km) !!\param de_lgth layer cloud decorrelation length (km) +!!\param alpha EXP/ER cloud overlap decorrelation parameter !!\param cldfmc cloud fraction for each sub-column !!\param taucld cloud optical depth for bands (non-mcica) !!\section gen_cldprop cldprop General Algorithm !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth, & + & nlay, nlp1, ipseed, dz, de_lgth, alpha, & & cldfmc, taucld & ! --- outputs & ) @@ -1528,6 +1572,7 @@ subroutine cldprop & ! ! ! dz - real, layer thickness (km) nlay ! ! de_lgth- real, layer cloud decorrelation length (km) 1 ! +! alpha - real, EXP/ER decorrelation parameter nlay ! ! nlay - integer, number of vertical layers 1 ! ! nlp1 - integer, number of vertical levels 1 ! ! ipseed- permutation seed for generating random numbers (isubclw>0) ! @@ -1598,6 +1643,7 @@ subroutine cldprop & real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz real (kind=kind_phys), intent(in) :: de_lgth + real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: real (kind=kind_phys), dimension(ngptlw,nlay),intent(out):: cldfmc @@ -1772,7 +1818,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, dz, de_lgth, & + & ( cldf, nlay, ipseed, dz, de_lgth, alpha, & ! --- output: & lcloudy & & ) @@ -1802,11 +1848,12 @@ end subroutine cldprop !!\param ipseed permute seed for random num generator !!\param dz layer thickness !!\param de_lgth layer cloud decorrelation length (km) +!!\param alpha EXP/ER cloud overlap decorrelation parameter !!\param lcloudy sub-colum cloud profile flag array !!\section mcica_subcol_gen mcica_subcol General Algorithm !! @{ subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, alpha, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -1821,6 +1868,7 @@ subroutine mcica_subcol & ! for lw and sw, use values differ by the number of g-pts. ! ! dz - real, layer thickness (km) nlay ! ! de_lgth - real, layer cloud decorrelation length (km) 1 ! +! alpha - real, EXP/ER decorrelation parameter nlay ! ! ! ! output variables: ! ! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! @@ -1838,6 +1886,7 @@ subroutine mcica_subcol & real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz real (kind=kind_phys), intent(in) :: de_lgth + real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: logical, dimension(ngptlw,nlay), intent(out) :: lcloudy @@ -1997,6 +2046,58 @@ subroutine mcica_subcol & enddo enddo + case( 4:5 ) ! exponential and exponential-random cloud overlap + +! --- Use previously derived decorrelation parameter, alpha, to specify +! the exponenential transition of cloud correlation in the vertical column. +! +! For exponential cloud overlap, the correlation is applied across layers +! without regard to the configuration of clear and cloudy layers. + +! For exponential-random cloud overlap, a new exponential transition is +! performed within each group of adjacent cloudy layers and blocks of +! cloudy layers with clear layers between them are correlated randomly. +! +! NOTE: The code below is identical for case (4) and (5) because the +! distinction in the vertical correlation between EXP and ER is already +! built into the specification of alpha (in subroutine get_alpha). + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + +! --- then working upward from the surface: +! if a random number (from an independent set: cdfun2) is smaller than +! alpha, then use the previous layer's number, otherwise use a new random +! number (keep the originally assigned one in cdfunc for that layer). + + do k = 2, nlay + k1 = k - 1 + do n = 1, ngptlw + if ( cdfun2(n,k) < alpha(k) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + end select !> -# Generate subcolumns for homogeneous clouds. diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index e91fc10df..4e371e7c5 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -207,6 +207,15 @@ kind = kind_phys intent = in optional = F +[alpha] + standard_name = cloud_overlap_decorrelation_parameter + long_name = cloud overlap decorrelation parameter + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F [npts] standard_name = horizontal_loop_extent long_name = horizontal dimension diff --git a/physics/radsw_main.f b/physics/radsw_main.f index b10541fb7..d285a8901 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -6,7 +6,7 @@ ! sw-rrtm3 radiation package description !!!!! ! ============================================================== !!!!! ! ! -! this package includes ncep's modifications of the rrtm-sw radiation ! +! this package includes ncep's modifications of the rrtmg-sw radiation ! ! code from aer inc. ! ! ! ! the sw-rrtm3 package includes these parts: ! @@ -38,7 +38,7 @@ ! inputs: ! ! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! ! clouds,icseed,aerosols,sfcalb, ! -! dzlyr,delpin,de_lgth, ! +! dzlyr,delpin,de_lgth,alpha, ! ! cosz,solcon,NDAY,idxday, ! ! npts, nlay, nlp1, lprnt, ! ! outputs: ! @@ -104,17 +104,38 @@ ! ! !==========================================================================! ! ! -! the original program declarations: ! +! the original aer program declarations: ! ! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ! -! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). ! -! This software may be used, copied, or redistributed as long as it is ! -! not sold and this copyright notice is reproduced on each copy made. ! -! This model is provided as is without any express or implied warranties. ! -! (http://www.rtweb.aer.com/) ! -! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! Copyright (c) 2002-2020, Atmospheric & Environmental Research, Inc. (AER) ! +! All rights reserved. ! +! ! +! Redistribution and use in source and binary forms, with or without ! +! modification, are permitted provided that the following conditions are met: ! +! * Redistributions of source code must retain the above copyright ! +! notice, this list of conditions and the following disclaimer. ! +! * Redistributions in binary form must reproduce the above copyright ! +! notice, this list of conditions and the following disclaimer in the ! +! documentation and/or other materials provided with the distribution. ! +! * Neither the name of Atmospheric & Environmental Research, Inc., nor ! +! the names of its contributors may be used to endorse or promote products ! +! derived from this software without specific prior written permission. ! +! ! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" ! +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ! +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ! +! ARE DISCLAIMED. IN NO EVENT SHALL ATMOSPHERIC & ENVIRONMENTAL RESEARCH, INC.,! +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ! +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ! +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ! +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN ! +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF ! +! THE POSSIBILITY OF SUCH DAMAGE. ! +! (http://www.rtweb.aer.com/) ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ! ************************************************************************ ! ! ! @@ -144,7 +165,13 @@ ! ************************************************************************ ! ! ! ! references: ! -! (rrtm_sw/rrtmg_sw): ! +! (rrtmg_sw/rrtm_sw): ! +! iacono, m.j., j.s. delamere, e.j. mlawer, m.w. shepard, ! +! s.a. clough, and w.d collins, radiative forcing by long-lived ! +! greenhouse gases: calculations with the aer radiative transfer ! +! models, j, geophys. res., 113, d13103, doi:10.1029/2008jd009944, ! +! 2008. ! +! ! ! clough, s.a., m.w. shephard, e.j. mlawer, j.s. delamere, ! ! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! ! atmospheric radiative transfer modeling: a summary of the aer ! @@ -189,7 +216,7 @@ ! ! ! ncep modifications history log: ! ! ! -! sep 2003, yu-tai hou -- received aer's rrtm-sw gcm version ! +! sep 2003, yu-tai hou -- received aer's rrtmg-sw gcm version! ! code (v224) ! ! nov 2003, yu-tai hou -- corrected errors in direct/diffuse ! ! surface alabedo components. ! @@ -260,12 +287,21 @@ ! scheme. (used if iswcliq=2); added new option of ! ! cloud overlap method 'de-correlation-length'. ! ! ! +! ************************************************************************ ! +! ! +! additional aer revision history: ! +! jul 2020, m.j. iacono -- added new mcica cloud overlap options ! +! exponential and exponential-random. each method can ! +! use either a constant or a latitude-varying and ! +! day-of-year varying decorrelation length selected ! +! with parameter "idcor". ! +! ! !!!!! ============================================================== !!!!! !!!!! end descriptions !!!!! !!!!! ============================================================== !!!!! -!> This module contains the CCPP-compliant NCEP's modifications of the rrtm-sw radiation -!! code from aer inc. +!> This module contains the CCPP-compliant NCEP's modifications of the +!! rrtmg-sw radiation code from aer inc. module rrtmg_sw ! use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & @@ -422,7 +458,7 @@ end subroutine rrtmg_sw_init !! | 29 | 820-2600 |H2O |CO2 |CO2 |H2O | !!\tableofcontents !! -!! The RRTM-SW package includes three files: +!! The RRTMG-SW package includes three files: !! - radsw_param.f, which contains: !! - module_radsw_parameters: specifies major parameters of the spectral !! bands and defines the construct structures of derived-type variables @@ -467,7 +503,7 @@ subroutine rrtmg_sw_run & & icseed, aeraod, aerssa, aerasy, & & sfcalb_nir_dir, sfcalb_nir_dif, & & sfcalb_uvis_dir, sfcalb_uvis_dif, & - & dzlyr,delpin,de_lgth, & + & dzlyr,delpin,de_lgth,alpha, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & & cld_cf, lsswr, & @@ -528,6 +564,7 @@ subroutine rrtmg_sw_run & ! dzlyr(npts,nlay) : layer thickness in km ! ! delpin(npts,nlay): layer pressure thickness (mb) ! ! de_lgth(npts) : clouds decorrelation length (km) ! +! alpha(npts,nlay) : EXP/ER cloud overlap decorrelation parameter ! ! cosz (npts) : cosine of solar zenith angle ! ! solcon : solar constant (w/m**2) ! ! NDAY : num of daytime points ! @@ -595,6 +632,8 @@ subroutine rrtmg_sw_run & ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! ! =3: decorrelation-length overlap clouds ! +! =4: exponential cloud overlap (AER) ! +! =5: exponential-random cloud overlap (AER) ! ! ivflip - control flg for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -691,6 +730,7 @@ subroutine rrtmg_sw_run & real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & & de_lgth(npts) + real (kind=kind_phys), dimension(npts,nlay), intent(in) :: alpha ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hswc @@ -740,6 +780,7 @@ subroutine rrtmg_sw_run & real (kind=kind_phys) :: cosz1, sntz1, tem0, tem1, tem2, s0fac, & & ssolar, zcf0, zcf1, ftoau0, ftoauc, ftoadc, & & fsfcu0, fsfcuc, fsfcd0, fsfcdc, suvbfc, suvbf0, delgth + real (kind=kind_phys), dimension(nlay) :: alph ! --- column amount of absorbing gases: ! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co @@ -869,6 +910,8 @@ subroutine rrtmg_sw_run & tavel(k) = tlyr(j1,kk) delp (k) = delpin(j1,kk) dz (k) = dzlyr (j1,kk) + if (iovrsw == 4 .or. iovrsw == 5) alph(k) = alpha(j1,k) ! alpha decorrelation + !> -# Set absorber and gas column amount, convert from volume mixing !! ratio to molec/cm2 based on coldry (scaled to 1.0e-20) !! - colamt(nlay,maxgas):column amounts of absorbing gases 1 to @@ -958,6 +1001,7 @@ subroutine rrtmg_sw_run & tavel(k) = tlyr(j1,k) delp (k) = delpin(j1,k) dz (k) = dzlyr (j1,k) + if (iovrsw == 4 .or. iovrsw == 5) alph(k) = alpha(j1,k) ! alpha decorrelation ! --- ... set absorber amount !test use @@ -1080,7 +1124,7 @@ subroutine rrtmg_sw_run & call cldprop & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & - & zcf1, nlay, ipseed(j1), dz, delgth, & + & zcf1, nlay, ipseed(j1), dz, delgth, alph, & ! --- outputs: & taucw, ssacw, asycw, cldfrc, cldfmc & & ) @@ -1409,7 +1453,7 @@ subroutine rswinit & ! !===> ... begin here ! - if ( iovrsw<0 .or. iovrsw>3 ) then + if ( iovrsw<0 .or. iovrsw>5 ) then print *,' *** Error in specification of cloud overlap flag', & & ' IOVRSW=',iovrsw,' in RSWINIT !!' stop @@ -1530,6 +1574,7 @@ end subroutine rswinit !! (isubcsw>0) !!\param dz layer thickness (km) !!\param delgth layer cloud decorrelation length (km) +!!\param alpha EXP/ER cloud overlap decorrelation parameter !!\param taucw cloud optical depth, w/o delta scaled !!\param ssacw weighted cloud single scattering albedo !! (ssa = ssacw / taucw) @@ -1542,7 +1587,7 @@ end subroutine rswinit !----------------------------------- subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cf1, nlay, ipseed, dz, delgth, & + & cf1, nlay, ipseed, dz, delgth, alpha, & & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1581,6 +1626,7 @@ subroutine cldprop & ! ipseed- permutation seed for generating random numbers (isubcsw>0) ! ! dz - real, layer thickness (km) nlay ! ! delgth- real, layer cloud decorrelation length (km) 1 ! +! alpha - real, EXP/ER decorrelation parameter nlay ! ! ! ! outputs: ! ! taucw - real, cloud optical depth, w/o delta scaled nlay*nbdsw ! @@ -1633,6 +1679,7 @@ subroutine cldprop & real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz + real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & @@ -1885,7 +1932,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, dz, delgth, & + & ( cldf, nlay, ipseed, dz, delgth, alpha, & ! --- outputs: & lcloudy & & ) @@ -1920,12 +1967,13 @@ end subroutine cldprop !!\param ipseed permute seed for random num generator !!\param dz layer thickness (km) !!\param de_lgth layer cloud decorrelation length (km) +!!\param alpha EXP/ER cloud overlap decorrelation parameter !!\param lcloudy sub-colum cloud profile flag array !!\section mcica_sw_gen mcica_subcol General Algorithm !> @{ ! ---------------------------------- subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, alpha, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -1940,6 +1988,7 @@ subroutine mcica_subcol & ! for lw and sw, use values differ by the number of g-pts. ! ! dz - real, layer thickness (km) nlay ! ! de_lgth-real, layer cloud decorrelation length (km) 1 ! +! alpha - real, EXP/ER decorrelation parameter nlay ! ! ! ! output variables: ! ! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! @@ -1950,6 +1999,8 @@ subroutine mcica_subcol & ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! ! =3: cloud decorrelation-length overlap method ! +! =4: exponential cloud overlap method (AER) ! +! =5: exponential-random cloud overlap method (AER) ! ! ! ! ===================== end of definitions ==================== ! @@ -1960,6 +2011,7 @@ subroutine mcica_subcol & real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz real (kind=kind_phys), intent(in) :: de_lgth + real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: logical, dimension(nlay,ngptsw), intent(out):: lcloudy @@ -2115,6 +2167,58 @@ subroutine mcica_subcol & enddo enddo + case( 4:5 ) ! exponential and exponential-random cloud overlap + +! --- Use previously derived decorrelation parameter, alpha, to specify +! the exponenential transition of cloud correlation in the vertical column. +! +! For exponential cloud overlap, the correlation is applied across layers +! without regard to the configuration of clear and cloudy layers. + +! For exponential-random cloud overlap, a new exponential transition is +! performed within each group of adjacent cloudy layers and blocks of +! cloudy layers with clear layers between them are correlated randomly. +! +! NOTE: The code below is identical for case (4) and (5) because the +! distinction in the vertical correlation between EXP and ER is already +! built into the specification of alpha (in subroutine get_alpha). + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(k,n) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfun2(k,n) = rand2d(k1) + enddo + enddo + +! --- then working upward from the surface: +! if a random number (from an independent set: cdfun2) is smaller than +! alpha, then use the previous layer's number, otherwise use a new random +! number (keep the originally assigned one in cdfunc for that layer). + + do n = 1, ngptsw + do k = 2, nlay + k1 = k - 1 + if ( cdfun2(k,n) < alpha(k) ) then + cdfunc(k,n) = cdfunc(k1,n) + endif + enddo + enddo + end select !> -# Generate subcolumns for homogeneous clouds. diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c8074cf47..37ce0d30c 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -234,6 +234,15 @@ kind = kind_phys intent = in optional = F +[alpha] + standard_name = cloud_overlap_decorrelation_parameter + long_name = cloud overlap decorrelation parameter + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F [cosz] standard_name = cosine_of_zenith_angle long_name = cosine of the solar zenit angle From 21f7fddfd1885896a2ac282c093c9529b10e1bd6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 20 Jul 2020 19:02:16 +0000 Subject: [PATCH 30/97] some minor fixes --- physics/GFS_MP_generic.F90 | 48 +++++++------------------------ physics/GFS_PBL_generic.F90 | 2 +- physics/GFS_rrtmg_pre.F90 | 4 +-- physics/GFS_time_vary_pre.fv3.F90 | 2 +- 4 files changed, 14 insertions(+), 42 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 68c19df42..8810cc7cf 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -253,40 +253,6 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, endif - if (lssav) then -! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & -! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & -! 'rain=',Diag%rain(1) - do i=1,im - cnvprcp (i) = cnvprcp (i) + rainc(i) - totprcp (i) = totprcp (i) + rain(i) - totice (i) = totice (i) + ice(i) - totsnw (i) = totsnw (i) + snow(i) - totgrp (i) = totgrp (i) + graupel(i) - - cnvprcpb(i) = cnvprcpb(i) + rainc(i) - totprcpb(i) = totprcpb(i) + rain(i) - toticeb (i) = toticeb (i) + ice(i) - totsnwb (i) = totsnwb (i) + snow(i) - totgrpb (i) = totgrpb (i) + graupel(i) - enddo - - if (ldiag3d) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain - enddo - enddo - if (qdiag3d) then - do k=1,levs - do i=1,im - dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain - enddo - enddo - endif - endif - endif - t850(1:im) = gt0(1:im,1) do k = 1, levs-1 @@ -365,9 +331,9 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, endif if (lssav) then -! if (Model%me == 0) print *,'in phys drive, kdt=',kdt, & -! 'totprcpb=', totprcpb(1),'totprcp=',totprcp(1), & -! 'rain=',rain(1) +! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & +! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & +! 'rain=',Diag%rain(1) do i=1,im cnvprcp (i) = cnvprcp (i) + rainc(i) totprcp (i) = totprcp (i) + rain(i) @@ -386,9 +352,15 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain enddo enddo + if (qdiag3d) then + do k=1,levs + do i=1,im + dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain + enddo + enddo + endif endif endif diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 77a1aa86f..f3eb212c7 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -626,7 +626,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if(qdiag3d) then do k=1,levs do i=1,im - dq3dt(i,k) = dq3dt(i,k) + (qgrs(i,k,ntqv)-save_q(i,k,ntqv)) + dq3dt (i,k) = dq3dt (i,k) + (qgrs(i,k,ntqv)-save_q(i,k,ntqv)) dq3dt_ozone(i,k) = dq3dt_ozone(i,k) + (qgrs(i,k,ntoz)-save_q(i,k,ntoz)) enddo enddo diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 5116d20b1..cc5b31447 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -141,13 +141,13 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs, rho, orho ! for Thompson MP - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & re_cloud, re_ice, re_snow, qv_mp, qc_mp, & qi_mp, qs_mp, nc_mp, ni_mp, nwfa diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index 98a0f6697..6a21199e9 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -171,7 +171,7 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & if (nslwr == 1) lslwr = .true. !--- allow for radiation to be called on every physics time step ! for the first nhfrad timesteps (for spinup, coldstarts only) - if (kdt<=nhfrad) then + if (kdt <= nhfrad) then lsswr = .true. lslwr = .true. end if From 3ff25ecf862941501bc5c2c1fba8d2cb05d207db Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Mon, 20 Jul 2020 19:42:26 +0000 Subject: [PATCH 31/97] Updated to new land pert scheme. --- physics/GFS_rrtmgp_sw_pre.F90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 6987c3e4a..827907e62 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -86,6 +86,7 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! Local variables integer :: i, j, iCol, iBand, iLay real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + real(kind_phys) :: lndp_alb ! Initialize CCPP error handling variables errmsg = '' @@ -117,13 +118,17 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! --- turn vegetation fraction pattern into percentile pattern ! ####################################################################################### alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + lndp_alb = -999. + if (Model%lndp_type ==1) then + do k =1,Model%n_var_lndp + if (Model%lndp_var_list(k) == 'alb') then do i=1,ncol - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + call cdfnor(Coupling%sfc_wts(i,k),alb1d(i)) + lndp_alb = Model%lndp_prt_list(k) enddo - endif - endif + endif + enddo + endif ! ####################################################################################### ! Call module_radiation_surface::setalb() to setup surface albedo. @@ -131,7 +136,7 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & - Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) From c2c4492d1c137a54eae76a6aa3c83515a1e36f35 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Jul 2020 11:07:36 +0000 Subject: [PATCH 32/97] updating sfx_diff to fix issues related to coupling to waves --- physics/sfc_diff.f | 4 +++- physics/sfc_diff.meta | 9 +++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 3ec69cd4f..f84da9bec 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -72,6 +72,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) + & z0rl_wav, & !intent(inout) & ustar_wat, ustar_lnd, ustar_ice, & !intent(inout) & cm_wat, cm_lnd, cm_ice, & !intent(inout) & ch_wat, ch_lnd, ch_ice, & !intent(inout) @@ -105,6 +106,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & & snwdph_wat,snwdph_lnd,snwdph_ice + real(kind=kind_phys), dimension(im), intent(in) :: z0rl_wav real(kind=kind_phys), dimension(im), intent(inout) :: & & z0rl_wat, z0rl_lnd, z0rl_ice, & & ustar_wat, ustar_lnd, ustar_ice, & @@ -355,7 +357,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_r8 endif - elseif (z0rl_wat(i) <= 1.0e-7_r8) then + elseif (z0rl_wav(i) <= 1.0e-7_r8) then z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) if (redrag) then diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index ab99dcb06..ea109c9e5 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -352,6 +352,15 @@ kind = kind_phys intent = inout optional = F +[z0rl_wav] + standard_name = surface_roughness_length_from_wave_model + long_name = surface roughness length from wave model + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [ustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean From 70ba799f342c05e61e74cf31123b0343a25d14d5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Jul 2020 23:48:43 +0000 Subject: [PATCH 33/97] fixing bug in orho in GFS_rrtmg_pre.F90 --- physics/GFS_rrtmg_pre.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index cc5b31447..ca7695528 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -590,7 +590,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) - nc_mp (i,k) = nt_c*orho(i,k1) + nc_mp (i,k) = nt_c*orho(i,k) ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs) enddo enddo From cfb269cedfc42a9016c18331cd9cf3bdba7f4a9f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Jul 2020 14:50:53 +0000 Subject: [PATCH 34/97] adding nthreads to sfc_nst.f --- physics/module_nst_water_prop.f90 | 7 ++++--- physics/sfc_nst.f | 12 ++++++------ physics/sfc_nst.meta | 16 ++++++++++++++++ 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 81e31b148..39020526c 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -657,7 +657,7 @@ subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) end subroutine get_dtzm_point !>\ingroup waterprop - subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) !subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) ! ===================================================================== ! ! ! @@ -687,6 +687,7 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) ! ny - integer, dimension in y-direction (meridional) 1 ! ! z1 - lower bound of depth of sea temperature 1 ! ! z2 - upper bound of depth of sea temperature 1 ! +! nth - integer, num of openmp thread 1 ! ! outputs: ! ! dtm - mean of dT(z) (z1 to z2) 1 ! ! @@ -694,7 +695,7 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) implicit none - integer, intent(in) :: nx,ny + integer, intent(in) :: nx,ny, nth real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc logical, dimension(nx,ny), intent(in) :: wet ! logical, dimension(nx,ny), intent(in) :: wet,icy @@ -706,7 +707,7 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) real (kind=kind_phys), parameter :: zero=0.0, half=0.5, one=1.0 -!$omp parallel do private(j,i,dtw,dtc,xzi) +!$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) do j = 1, ny do i= 1, nx diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 72982e248..cfe191a85 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -676,7 +676,7 @@ end subroutine sfc_nst_pre_finalize !! @{ subroutine sfc_nst_pre_run & (im, wet, tsfc_wat, tsurf_wat, tseal, xt, xz, dt_cool, - & z_c, tref, cplflx, oceanfrac, errmsg, errflg) + & z_c, tref, cplflx, oceanfrac, nthreads, errmsg, errflg) use machine , only : kind_phys use module_nst_water_prop, only: get_dtzm_2d @@ -686,7 +686,7 @@ subroutine sfc_nst_pre_run integer, parameter :: r8 = kind_phys ! --- inputs: - integer, intent(in) :: im + integer, intent(in) :: im, nthreads logical, dimension(im), intent(in) :: wet real (kind=kind_phys), dimension(im), intent(in) :: & tsfc_wat, xt, xz, dt_cool, z_c, oceanfrac @@ -730,7 +730,7 @@ subroutine sfc_nst_pre_run ! if (cplflx) then call get_dtzm_2d (xt, xz, dt_cool, & - & z_c, wet, zero, omz1, im, 1, dtzm) + & z_c, wet, zero, omz1, im, 1, nthreads, dtzm) do i=1,im if (wet(i) .and. oceanfrac(i) > zero) then ! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf @@ -786,7 +786,7 @@ end subroutine sfc_nst_post_finalize subroutine sfc_nst_post_run & & ( im, rlapse, tgice, wet, icy, oro, oro_uf, nstf_name1, & & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_wat, tsfc_wat, dtzm, errmsg, errflg & + & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & & ) use machine , only : kind_phys @@ -797,7 +797,7 @@ subroutine sfc_nst_post_run & integer, parameter :: r8 = kind_phys ! --- inputs: - integer, intent(in) :: im + integer, intent(in) :: im, nthreads logical, dimension(im), intent(in) :: wet, icy real (kind=kind_phys), intent(in) :: rlapse, tgice real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf @@ -840,7 +840,7 @@ subroutine sfc_nst_post_run & zsea1 = 0.001_r8*real(nstf_name4) zsea2 = 0.001_r8*real(nstf_name5) call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & - & im, 1, dtzm) + & im, 1, nthreads, dtzm) do i = 1, im ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 4198af0eb..ed0451aaa 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -768,6 +768,14 @@ kind = kind_phys intent = in optional = F +[nthreads] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -956,6 +964,14 @@ kind = kind_phys intent = inout optional = F +[nthreads] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [dtzm] standard_name = mean_change_over_depth_in_sea_water_temperature long_name = mean of dT(z) (zsea1 to zsea2) From ddcc4b84e5059dd2dbf8be65f334bbcc631ad410 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 29 Jul 2020 19:18:53 +0000 Subject: [PATCH 35/97] fixing a typo in ugwp_driver_v0.F --- physics/ugwp_driver_v0.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index abba5137f..f209cf97a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -138,7 +138,7 @@ subroutine cires_ugwp_driver_v0(me, master, pkdis(i,k) = zero enddo enddo - if (cdmbgwd(1) > zero.or. cdmbgwd(2) > zero)_r8 then + if (cdmbgwd(1) > zero.or. cdmbgwd(2) > zero) then call gwdps(im, im, im, levs, Pdvdt, Pdudt, Pdtdt & &, ugrs, vgrs, tgrs, qgrs & &, kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt& From e530096764773b67fa30c7f3b11285c81bb5374d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 30 Jul 2020 17:39:57 +0000 Subject: [PATCH 36/97] fixing one file --- physics/ugwp_driver_v0.F | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index f209cf97a..f573c8776 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -38,7 +38,7 @@ subroutine cires_ugwp_driver_v0(me, master, implicit none !input - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, intent(in) :: me, master integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr @@ -89,9 +89,9 @@ subroutine cires_ugwp_driver_v0(me, master, ! ! switches that activate impact of OGWs and NGWs along with eddy diffusion ! - real(kind=kind_phys), parameter :: pogw=1.0_r8, pngw=1.0_r8 - &, pked=1.0_r8, zero=0.0_r8 - &, ompked=1.0_r8-pked + real(kind=kind_phys), parameter :: pogw=1.0_kp, pngw=1.0_kp + &, pked=1.0_kp, zero=0.0_kp + &, ompked=1.0_kp-pked ! ! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) ! @@ -162,7 +162,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! call slat_geos5(im, xlatd, tau_ngw) ! - if (abs(1.0_r8-cdmbgwd(3)) > 1.0e-6_r8) then + if (abs(1.0_kp-cdmbgwd(3)) > 1.0e-6_kp) then if (cdmbgwd(4) > zero) then do i=1,im turb_fac(i) = zero @@ -182,7 +182,7 @@ subroutine cires_ugwp_driver_v0(me, master, rfac = 86400000 / dtp do i=1,im tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) - tau_ngw(i) = tau_ngw(i) * max(0.1_r8, min(5.0_r8, tx1)) + tau_ngw(i) = tau_ngw(i) * max(0.1_kp, min(5.0_kp, tx1)) enddo endif do i=1,im @@ -317,7 +317,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, use sso_coorde, only : pgwd, pgwd4, debugprint !---------------------------------------- implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' integer, intent(in) :: im, km, imx, kdt integer, intent(in) :: me, master @@ -363,9 +363,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! cleff = 2.5*0.5e-5 * sqrt(192./768.) => Lh_eff = 1004. km ! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective !--------------------------------------------------------------------- - real(kind=kind_phys) :: gammin = 0.00999999_r8 - real(kind=kind_phys), parameter :: nhilmax = 25.0_r8 - real(kind=kind_phys), parameter :: sso_min = 3000.0_r8 + real(kind=kind_phys) :: gammin = 0.00999999_kp + real(kind=kind_phys), parameter :: nhilmax = 25.0_kp + real(kind=kind_phys), parameter :: sso_min = 3000.0_kp logical, parameter :: do_adjoro = .true. ! real(kind=kind_phys) :: shilmin, sgrmax, sgrmin @@ -439,7 +439,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) dxres = pi2*arad/float(IMX) - hdxres = 0.5_r8*dxres + hdxres = 0.5_kp*dxres ! shilmin = sgrmin/nhilmax ! not used - Moorthi ! gammin = min(sso_min/dsmax, 1.) ! Moorthi - with this results are not reproducible @@ -1311,7 +1311,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, implicit none !23456 - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles @@ -1338,9 +1338,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5_r8 ! - real, parameter :: epsln = 1.0e-12_r8 ! - real, parameter :: zero = 0.0_r8, one = 1.0_r8, half = 0.5_r8 + real, parameter :: minvel = 0.5_kp ! + real, parameter :: epsln = 1.0e-12_kp ! + real, parameter :: zero = 0.0_kp, one = 1.0_kp, half = 0.5_kp !vay-2018 @@ -1466,7 +1466,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, tvc1 = tm1(jl,jk) * (one +fv*qm1(jl,jk)) tvm1 = tm1(jl,jk-1) * (one +fv*qm1(jl,jk-1)) ! zthm1(jl,jk) = 0.5 *(tvc1+tvm1) - zthm1 = 2.0_r8 / (tvc1+tvm1) + zthm1 = 2.0_kp / (tvc1+tvm1) zuhm1(jl,jk) = half *(um1(jl,jk-1)+um1(jl,jk)) zvhm1(jl,jk) = half *(vm1(jl,jk-1)+vm1(jl,jk)) ! zrhohm1(jl,jk) = prsi(jl,jk)*rdi/zthm1(jl,jk) ! rho = p/(RTv) @@ -1475,7 +1475,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_zmet(jl,jk) = zdelp + zdelp delpi(jl,jk) = grav / (prsi(jl,jk-1) - prsi(jl,jk)) vueff(jl,jk) = - & 2.e-5_r8*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min + & 2.e-5_kp*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min ! ! zbn2(jl,jk) = grav2cpd/zthm1(jl,jk) zbn2(jl,jk) = grav2cpd*zthm1 From 5943288b2298112dbdea47bba9af1385fbb660c5 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 31 Jul 2020 17:29:24 +0000 Subject: [PATCH 37/97] Changes for flexible number of soil levels. --- physics/gcycle.F90 | 36 ++++--- physics/sfcsub.F | 255 +++++++++++---------------------------------- 2 files changed, 86 insertions(+), 205 deletions(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index bc1bb032c..c37d39d10 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -58,9 +58,9 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ABSFCS (Model%nx*Model%ny), & ALFFC1 (Model%nx*Model%ny*2), & ALBFC1 (Model%nx*Model%ny*4), & - SMCFC1 (Model%nx*Model%ny*Model%lsoil), & - STCFC1 (Model%nx*Model%ny*Model%lsoil), & - SLCFC1 (Model%nx*Model%ny*Model%lsoil) + SMCFC1 (Model%nx*Model%ny*max(Model%lsoil,Model%lsoil_lsm)), & + STCFC1 (Model%nx*Model%ny*max(Model%lsoil,Model%lsoil_lsm)), & + SLCFC1 (Model%nx*Model%ny*max(Model%lsoil,Model%lsoil_lsm)) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi @@ -134,10 +134,16 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ALBFC1 (len + npts*2) = Sfcprop(nb)%alnsf (ix) ALBFC1 (len + npts*3) = Sfcprop(nb)%alnwf (ix) - do ls = 1,Model%lsoil - SMCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%smc (ix,ls) - STCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%stc (ix,ls) - SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%slc (ix,ls) + do ls = 1,max(Model%lsoil,Model%lsoil_lsm) + if (Model%lsoil == Model%lsoil_lsm) then + SMCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%smc (ix,ls) + STCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%stc (ix,ls) + SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%slc (ix,ls) + else + SMCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%smois (ix,ls) + STCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%tslb (ix,ls) + SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%sh2o (ix,ls) + endif enddo IF (SLIFCS(len) .LT. 0.1 .OR. SLIFCS(len) .GT. 1.5) THEN @@ -171,7 +177,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) rewind (Model%nlunit) endif #endif - CALL SFCCYCLE (9998, npts, Model%lsoil, SIG1T, Model%fhcyc, & + CALL SFCCYCLE (9998, npts, max(Model%lsoil,Model%lsoil_lsm), SIG1T, Model%fhcyc, & Model%idate(4), Model%idate(2), & Model%idate(3), Model%idate(1), & Model%phour, RLA, RLO, SLMASK, & @@ -235,10 +241,16 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%alvwf (ix) = ALBFC1 (len + npts ) Sfcprop(nb)%alnsf (ix) = ALBFC1 (len + npts*2) Sfcprop(nb)%alnwf (ix) = ALBFC1 (len + npts*3) - do ls = 1,Model%lsoil - Sfcprop(nb)%smc (ix,ls) = SMCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%stc (ix,ls) = STCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%slc (ix,ls) = SLCFC1 (len + (ls-1)*npts) + do ls = 1,max(Model%lsoil,Model%lsoil_lsm) + if(Model%lsoil == Model%lsoil_lsm) then + Sfcprop(nb)%smc (ix,ls) = SMCFC1 (len + (ls-1)*npts) + Sfcprop(nb)%stc (ix,ls) = STCFC1 (len + (ls-1)*npts) + Sfcprop(nb)%slc (ix,ls) = SLCFC1 (len + (ls-1)*npts) + else + Sfcprop(nb)%smois (ix,ls) = SMCFC1 (len + (ls-1)*npts) + Sfcprop(nb)%tslb (ix,ls) = STCFC1 (len + (ls-1)*npts) + Sfcprop(nb)%sh2o (ix,ls) = SLCFC1 (len + (ls-1)*npts) + endif if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (len + (ls-1)*npts) enddo ENDDO !-----END BLOCK SIZE LOOP------------------------------ diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 6296e7856..a78ac650f 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -3,7 +3,7 @@ !>\defgroup mod_sfcsub GFS sfcsub Module -!!\ingroup Noah_LSM +!!\ingroup LSMs !> @{ !! This module contains grib code for each parameter-used in subroutines sfccycle() !! and setrmsk(). @@ -299,7 +299,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & parameter(plrlmx=1000.,plrlmn=0.0,plromx=1000.0,plromn=0.0, & plrsmx=1000.,plrsmn=0.0,plrimx=1000.,plrimn=0.0, & plrjmx=1000.,plrjmn=0.0) -!clu [-1l/+1l] relax tsfsmx (for noah lsm) +!clu [-1l/+1l] relax tsfsmx parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.2, & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.2,tsfimn=173.0, & tsfjmx=273.16,tsfjmn=173.0) @@ -384,8 +384,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & parameter(snwmin=5.0,snwmax=100.) real (kind=kind_io8), parameter :: ten=10.0, one=1.0 ! -! coeeficients of blending forecast and interpolated clim +! coeficients of blending forecast and interpolated clim ! (or analyzed) fields over sea or land(l) (not for clouds) +!tgs -- important ! 1.0 = use of forecast ! 0.0 = replace with interpolated analysis ! @@ -395,10 +396,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! --------------------------------------------------------- ! surface temperature forecast analysis ! surface temperature forecast forecast (over sea ice) -! albedo analysis analysis +! albedo forecast/analysis analysis ! sea-ice analysis analysis -! snow analysis forecast (over sea ice) -! roughness analysis forecast +! snow forecast/analysis forecast (over sea ice) +! roughness forecast/analysis forecast ! plant resistance analysis analysis ! soil wetness (layer) weighted average analysis ! soil temperature forecast analysis @@ -416,7 +417,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! max snow albedo analysis analysis ! slope type analysis analysis ! liquid soil wetness analysis-weighted analysis -! actual snow depth analysis-weighted analysis +! actual snow depth forecast/analysis-weighted analysis ! ! note: if analysis file is not given, then time interpolated climatology ! is used. if analyiss file is given, it will be used as far as the @@ -533,9 +534,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! rec. 1 label ! rec. 2 date record ! rec. 3 tsf -! rec. 4 soilm(two layers) ----> 4 layers +! rec. 4 soilm(lsoil) ! rec. 5 snow -! rec. 6 soilt(two layers) ----> 4 layers +! rec. 6 soilt(lsoil) ! rec. 7 tg3 ! rec. 8 zor ! rec. 9 cv @@ -560,7 +561,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! rec. 25 tprcp ! rec. 26 srflag ! rec. 27 swd -! rec. 28 slc (4 layers) +! rec. 28 slc (lsoil) ! rec. 29 vmn ! rec. 30 vmx ! rec. 31 slp @@ -1234,50 +1235,27 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! get soil temp and moisture (after all the qcs are completed) ! + !-- soil moisture if(fnsmcc(1:8).eq.' ') then call getsmc(wetclm,len,lsoil,smcclm,me) endif - call qcmxmn('smc1c ',smcclm(1,1),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2c ',smcclm(1,2),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, + do k=1,lsoil + call qcmxmn('smc ',smcclm(1,k),sliclm,snoclm,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo + !-- soil temperature if(fnstcc(1:8).eq.' ') then call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif - call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2c ',stcclm(1,2),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, + do k=1,lsoil + call qcmxmn('stc ',stcclm(1,k),sliclm,snoclm,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo + call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, @@ -1335,17 +1313,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('aisclm',aisclm,sliclm,snoclm,len) call monitr('snoclm',snoclm,sliclm,snoclm,len) call monitr('scvclm',scvclm,sliclm,snoclm,len) - call monitr('smcclm1',smcclm(1,1),sliclm,snoclm,len) - call monitr('smcclm2',smcclm(1,2),sliclm,snoclm,len) - call monitr('stcclm1',stcclm(1,1),sliclm,snoclm,len) - call monitr('stcclm2',stcclm(1,2),sliclm,snoclm,len) -!clu [+4l] add smcclm(3:4) and stcclm(3:4) - if(lsoil.gt.2) then - call monitr('smcclm3',smcclm(1,3),sliclm,snoclm,len) - call monitr('smcclm4',smcclm(1,4),sliclm,snoclm,len) - call monitr('stcclm3',stcclm(1,3),sliclm,snoclm,len) - call monitr('stcclm4',stcclm(1,4),sliclm,snoclm,len) - endif + do k=1,lsoil + call monitr('smcclm1',smcclm(1,k),sliclm,snoclm,len) + call monitr('stcclm1',stcclm(1,k),sliclm,snoclm,len) + enddo call monitr('tg3clm',tg3clm,sliclm,snoclm,len) call monitr('zorclm',zorclm,sliclm,snoclm,len) ! if (gaus) then @@ -1637,47 +1608,23 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & if(fnsmca(1:8).eq.' ' .and. fnsmcc(1:8).eq.' ') then call getsmc(wetanl,len,lsoil,smcanl,me) endif - call qcmxmn('smc1a ',smcanl(1,1),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2a ',smcanl(1,2),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, + !-- soil moisture + do k=1,lsoil + call qcmxmn('smca ',smcanl(1,1),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo + !-- soil temperature if(fnstca(1:8).eq.' ') then call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif - call qcmxmn('stc1a ',stcanl(1,1),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2a ',stcanl(1,2),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, + do k=1,lsoil + call qcmxmn('stca ',stcanl(1,1),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, @@ -1723,17 +1670,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('aisanl',aisanl,slianl,snoanl,len) call monitr('snoanl',snoanl,slianl,snoanl,len) call monitr('scvanl',scvanl,slianl,snoanl,len) - call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) -!clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) - endif + do k=1,lsoil + call monitr('smcanl',smcanl(1,k),slianl,snoanl,len) + call monitr('stcanl',stcanl(1,k),slianl,snoanl,len) + enddo call monitr('tg3anl',tg3anl,slianl,snoanl,len) call monitr('zoranl',zoranl,slianl,snoanl,len) ! if (gaus) then @@ -1902,44 +1842,20 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, & sicjmx,sicjmn,sicsmx,sicsmn,epssic, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc1f ',smcfcs(1,1),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2f ',smcfcs(1,2),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, +!-- soil moisture forecast + do k=1,lsoil + call qcmxmn('smcf ',smcfcs(1,k),slifcs,snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, + enddo +!-- soil temperature forecast + do k=1,lsoil + call qcmxmn('stcf ',stcfcs(1,k),slifcs,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, @@ -1985,17 +1901,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('albfcs',albfcs,slifcs,snofcs,len) call monitr('aisfcs',aisfcs,slifcs,snofcs,len) call monitr('snofcs',snofcs,slifcs,snofcs,len) - call monitr('smcfcs1',smcfcs(1,1),slifcs,snofcs,len) - call monitr('smcfcs2',smcfcs(1,2),slifcs,snofcs,len) - call monitr('stcfcs1',stcfcs(1,1),slifcs,snofcs,len) - call monitr('stcfcs2',stcfcs(1,2),slifcs,snofcs,len) -!clu [+4l] add smcfcs(3:4) and stcfcs(3:4) - if(lsoil.gt.2) then - call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len) - call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len) - call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len) - call monitr('stcfcs4',stcfcs(1,4),slifcs,snofcs,len) - endif + do k=1,lsoil + call monitr('smcfcs',smcfcs(1,k),slifcs,snofcs,len) + call monitr('stcfcs',stcfcs(1,k),slifcs,snofcs,len) + enddo call monitr('tg3fcs',tg3fcs,slifcs,snofcs,len) call monitr('zorfcs',zorfcs,slifcs,snofcs,len) ! if (gaus) then @@ -2138,44 +2047,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif - call qcmxmn('stc1m ',stcanl(1,1),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2m ',stcanl(1,2),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, + do k=1,lsoil + call qcmxmn('stcm ',stcanl(1,k),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif - call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc2m ',smcanl(1,2),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, + enddo + do k=1,lsoil + call qcmxmn('smcm ',smcanl(1,k),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) - endif + enddo kqcm=1 call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -2258,19 +2141,12 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('albanl',albanl,slianl,snoanl,len) call monitr('aisanl',aisanl,slianl,snoanl,len) call monitr('snoanl',snoanl,slianl,snoanl,len) - call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) -!clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) + do k=1,lsoil + call monitr('smcanl',smcanl(1,k),slianl,snoanl,len) + call monitr('stcanl',stcanl(1,k),slianl,snoanl,len) + enddo call monitr('tg3anl',tg3anl,slianl,snoanl,len) call monitr('zoranl',zoranl,slianl,snoanl,len) - endif ! if (gaus) then call monitr('cvaanl',cvanl ,slianl,snoanl,len) call monitr('cvbanl',cvbanl,slianl,snoanl,len) @@ -2344,17 +2220,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('albdif4',albfcs(1,4),slianl,snoanl,len) call monitr('aisdif',aisfcs,slianl,snoanl,len) call monitr('snodif',snofcs,slianl,snoanl,len) - call monitr('smcanl1',smcfcs(1,1),slianl,snoanl,len) - call monitr('smcanl2',smcfcs(1,2),slianl,snoanl,len) - call monitr('stcanl1',stcfcs(1,1),slianl,snoanl,len) - call monitr('stcanl2',stcfcs(1,2),slianl,snoanl,len) -!clu [+4l] add smcfcs(3:4) and stc(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) - endif + do k=1,lsoil + call monitr('smcanl',smcfcs(1,k),slianl,snoanl,len) + call monitr('stcanl',stcfcs(1,k),slianl,snoanl,len) + enddo call monitr('tg3dif',tg3fcs,slianl,snoanl,len) call monitr('zordif',zorfcs,slianl,snoanl,len) ! if (gaus) then From 4b11e849183fa7635c0db6fd0631159159ec126c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 3 Aug 2020 13:36:11 +0000 Subject: [PATCH 38/97] fixing issues related to z0 and restart reproducibility --- physics/GFS_surface_composites.F90 | 25 +++++++++++++------------ physics/gcycle.F90 | 14 ++++++++++++-- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index a08fcca76..b3000b008 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -144,18 +144,18 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx enddo endif - if (.not. cplflx .or. .not. frac_grid) then - if (cplwav2atm) then - do i=1,im - zorll(i) = zorl(i) - enddo - else - do i=1,im - zorll(i) = zorl(i) - zorlo(i) = zorl(i) - enddo - endif - endif +! if (.not. cplflx .or. .not. frac_grid) then +! if (cplwav2atm) then +! do i=1,im +! zorll(i) = zorl(i) +! enddo +! else +! do i=1,im +! zorll(i) = zorl(i) +! zorlo(i) = zorl(i) +! enddo +! endif +! endif do i=1,im tprcp_wat(i) = tprcp(i) @@ -546,6 +546,7 @@ subroutine GFS_surface_composites_post_run ( qss(i) = qss_ice(i) if (.not. flag_cice(i)) then tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + zorl(i) = cice(i) * zorl_ice(i) + (one - cice(i)) * zorl_wat(i) elseif (wet(i)) then if (cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice txi = cice(i) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index b076f69bd..56d774afd 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -109,7 +109,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TSFFCS(len) = Sfcprop(nb)%tsfc (ix) endif SNOFCS (len) = Sfcprop(nb)%weasd (ix) - ZORFCS (len) = Sfcprop(nb)%zorl (ix) + ZORFCS (len) = Sfcprop(nb)%zorll (ix) + if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then + ZORFCS (len) = Sfcprop(nb)%zorli (ix) + elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then + ZORFCS (len) = Sfcprop(nb)%zorlo (ix) + endif TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) ! F10MFCS (len) = Sfcprop(nb)%f10m (ix) @@ -217,7 +222,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) - Sfcprop(nb)%zorl (ix) = ZORFCS (len) + Sfcprop(nb)%zorll (ix) = ZORFCS (len) + if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then + Sfcprop(nb)%zorli(ix) = ZORFCS (len) + elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then + Sfcprop(nb)%zorlo(ix) = ZORFCS (len) + endif Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) ! Sfcprop(nb)%f10m (ix) = F10MFCS (len) From 04f660ba4e305028a3c8064239619266971226d6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 Aug 2020 15:16:33 +0000 Subject: [PATCH 39/97] adding _kp in place of -r8 in some routines --- physics/GFS_PBL_generic.F90 | 10 +- physics/gcm_shoc.F90 | 160 ++++----- physics/m_micro.F90 | 354 ++++++++++---------- physics/moninshoc.f | 38 +-- physics/rascnv.F90 | 382 +++++++++++----------- physics/sfc_diff.f | 112 +++---- physics/sfc_nst.f | 56 ++-- physics/wv_saturation.F | 636 ++++++++++++++++++------------------ 8 files changed, 874 insertions(+), 874 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index f3eb212c7..357309b2a 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -92,7 +92,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm @@ -111,7 +111,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real (kind=kind_phys), parameter :: zero = 0.0_r8, one=1.0_r8 + real (kind=kind_phys), parameter :: zero = 0.0_kp, one=1.0_kp ! Local variables integer :: i, k, kk, k1, n @@ -325,7 +325,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef logical, intent(in) :: trans_aero @@ -375,9 +375,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: zero = 0.0_r8, one = 1.0_r8 + real(kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 - real(kind=kind_phys), parameter :: qmin = 1.0e-8_r8 + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kp integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, rho diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 5f755a779..dd7791e18 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -10,7 +10,7 @@ module shoc private public shoc_run, shoc_init, shoc_finalize - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys contains @@ -45,7 +45,7 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: epsq = 1.0e-20_r8, zero=0.0_r8, one=1.0_r8 + real(kind=kind_phys), parameter :: epsq = 1.0e-20_kp, zero=0.0_kp, one=1.0_kp integer :: i, k @@ -219,34 +219,34 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s - real, parameter :: zero=0.0_r8, one=1.0_r8, half=0.5_r8, two=2.0_r8, eps=0.622_r8, & - three=3.0_r8, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 - real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0_r8, & - nmin = 1.0_r8, RI_cub = 6.4e-14_r8, RL_cub = 1.0e-15_r8, & - skew_facw=1.2_r8, skew_fact=0.0_r8, & - tkhmax=300.0_r8, qcmin=1.0e-9_r8 + real, parameter :: zero=0.0_kp, one=1.0_kp, half=0.5_kp, two=2.0_kp, eps=0.622_kp, & + three=3.0_kp, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 + real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0_kp, & + nmin = 1.0_kp, RI_cub = 6.4e-14_kp, RL_cub = 1.0e-15_kp, & + skew_facw=1.2_kp, skew_fact=0.0_kp, & + tkhmax=300.0_kp, qcmin=1.0e-9_kp real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & rog, sqrtpii, epsterm, onebeps, onebrvcp ! SHOC tunable parameters - real, parameter :: lambda = 0.04_r8 -! real, parameter :: min_tke = 1.0e-6_r8 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1.0e-4_r8 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0_r8 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0_r8 ! Maximum TKE value, m**2/s**2 + real, parameter :: lambda = 0.04_kp +! real, parameter :: min_tke = 1.0e-6_kp ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0e-4_kp ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0_kp ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0_kp ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000.0_r8 - real, parameter :: max_eddy_length_scale = 1000.0_r8 +! real, parameter :: max_eddy_length_scale = 2000.0_kp + real, parameter :: max_eddy_length_scale = 1000.0_kp ! Maximum "return-to-isotropy" time scale, s - real, parameter :: max_eddy_dissipation_time_scale = 2000.0_r8 - real, parameter :: Pr = 1.0_r8 ! Prandtl number + real, parameter :: max_eddy_dissipation_time_scale = 2000.0_kp + real, parameter :: Pr = 1.0_kp ! Prandtl number ! Constants for the TKE dissipation term based on Deardorff (1980) - real, parameter :: pt19=0.19_r8, pt51=0.51_r8, pt01=0.01_r8, atmin=0.01_r8, atmax=one-atmin - real, parameter :: Cs = 0.15_r8, epsln=1.0e-6_r8 -! real, parameter :: Ck = 0.2_r8 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 - real, parameter :: Ck = 0.1_r8 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: pt19=0.19_kp, pt51=0.51_kp, pt01=0.01_kp, atmin=0.01_kp, atmax=one-atmin + real, parameter :: Cs = 0.15_kp, epsln=1.0e-6_kp +! real, parameter :: Ck = 0.2_kp ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: Ck = 0.1_kp ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 @@ -260,28 +260,28 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & ! real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce*3.0/0.7 ! real, parameter :: vonk=0.35 ! Von Karman constant - real, parameter :: vonk=0.4_r8 ! Von Karman constant Moorthi - as in GFS - real, parameter :: tscale=400.0_r8 ! time scale set based off of similarity results of BK13, s - real, parameter :: w_tol_sqd = 4.0e-04_r8 ! Min vlaue of second moment of w -! real, parameter :: w_tol_sqd = 1.0e-04_r8 ! Min vlaue of second moment of w - real, parameter :: w_thresh = 0.0_r8, thresh = 0.0_r8 - real, parameter :: w3_tol = 1.0e-20_r8 ! Min vlaue of third moment of w + real, parameter :: vonk=0.4_kp ! Von Karman constant Moorthi - as in GFS + real, parameter :: tscale=400.0_kp ! time scale set based off of similarity results of BK13, s + real, parameter :: w_tol_sqd = 4.0e-04_kp ! Min vlaue of second moment of w +! real, parameter :: w_tol_sqd = 1.0e-04_kp ! Min vlaue of second moment of w + real, parameter :: w_thresh = 0.0_kp, thresh = 0.0_kp + real, parameter :: w3_tol = 1.0e-20_kp ! Min vlaue of third moment of w ! These parameters are a tie-in with a microphysical scheme ! Double check their values for the Zhao-Carr scheme. - real, parameter :: tbgmin = 233.16_r8 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 258.16_r8 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 253.16_r8 ! Minimum temperature for cloud water., K - real, parameter :: tbgmax = 273.16_r8 ! Maximum temperature for cloud ice, K + real, parameter :: tbgmin = 233.16_kp ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 258.16_kp ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 253.16_kp ! Minimum temperature for cloud water., K + real, parameter :: tbgmax = 273.16_kp ! Maximum temperature for cloud ice, K real, parameter :: a_bg = one/(tbgmax-tbgmin) ! ! Parameters to tune the second order moments- No tuning is performed currently -! real, parameter :: thl2tune = 2.0_r8, qw2tune = 2.0_r8, qwthl2tune = 2.0_r8, & - real, parameter :: thl2tune = 1.0_r8, qw2tune = 1.0_r8, qwthl2tune = 1.0_r8, & -! thl_tol = 1.0e-4_r8, rt_tol = 1.0e-8_r8, basetemp = 300.0_r8 - thl_tol = 1.0e-2_r8, rt_tol = 1.0e-4_r8 +! real, parameter :: thl2tune = 2.0_kp, qw2tune = 2.0_kp, qwthl2tune = 2.0_kp, & + real, parameter :: thl2tune = 1.0_kp, qw2tune = 1.0_kp, qwthl2tune = 1.0_kp, & +! thl_tol = 1.0e-4_kp, rt_tol = 1.0e-8_kp, basetemp = 300.0_kp + thl_tol = 1.0e-2_kp, rt_tol = 1.0e-4_kp integer, parameter :: nitr=6 @@ -453,7 +453,7 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & ! total_water(i,k) = qcl(i,k) + qci(i,k) + qv(i,k) - prespot = (100000.0_r8*wrk) ** kapa ! Exner function + prespot = (100000.0_kp*wrk) ** kapa ! Exner function bet(i,k) = ggr/(tabs(i,k)*prespot) ! Moorthi thv(i,k) = thv(i,k)*prespot ! Moorthi ! @@ -635,8 +635,8 @@ subroutine tke_shoc() if (dis_opt > 0) then do i=1,nx - wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5_r8 - cek(i) = (one + two / max((wrk*wrk - 3.3_r8), 0.5_r8)) * cefac + wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5_kp + cek(i) = (one + two / max((wrk*wrk - 3.3_kp), 0.5_kp)) * cefac enddo else if (k == 1) then @@ -660,7 +660,7 @@ subroutine tke_shoc() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001_r8) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001_kp) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) @@ -668,7 +668,7 @@ subroutine tke_shoc() if (buoy_sgs <= zero) then smix = grd else - smix = min(grd,max(0.1_r8*grd, 0.76_r8*sqrt(tke(i,k)/(buoy_sgs+1.0e-10_r8)))) + smix = min(grd,max(0.1_kp*grd, 0.76_kp*sqrt(tke(i,k)/(buoy_sgs+1.0e-10_kp)))) endif ratio = smix/grd @@ -810,9 +810,9 @@ subroutine eddy_length() ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) do i=1,nx if (denom(i) > zero .and. numer(i) > zero) then - l_inf(i) = min(0.1_r8 * (numer(i)/denom(i)), 100.0_r8) + l_inf(i) = min(0.1_kp * (numer(i)/denom(i)), 100.0_kp) else - l_inf(i) = 100.0_r8 + l_inf(i) = 100.0_kp endif enddo @@ -848,7 +848,7 @@ subroutine eddy_length() ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,k) / (wrk+1.0e-20_r8) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.0e-20_kp) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp @@ -867,7 +867,7 @@ subroutine eddy_length() ! liquid/ice moist static energy static energy divided by cp? bbb = (one + epsv*qsatt-wrk-qpl(i,k)-qpi(i,k) & - + 1.61_r8*tabs(i,k)*dqsat) / (one+lstarn*dqsat) + + 1.61_kp*tabs(i,k)*dqsat) / (one+lstarn*dqsat) ! Calculate Brunt-Vaisalla frequency using centered differences in the vertical @@ -917,7 +917,7 @@ subroutine eddy_length() wrk1 = one / (tscale*tkes*vonk*zl(i,k)) wrk2 = one / (tscale*tkes*l_inf(i)) wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,k) / tke(i,k) - wrk1 = sqrt(one / max(wrk1,1.0e-8_r8)) * (one/0.3_r8) + wrk1 = sqrt(one / max(wrk1,1.0e-8_kp)) * (one/0.3_kp) ! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) smixt(i,k) = min(max_eddy_length_scale, wrk1) @@ -988,7 +988,7 @@ subroutine eddy_length() ! The calculation below finds the integral in the Eq. 10 in BK13 for the current cloud conv_var = zero do kk=kl,ku - conv_var = conv_var+ 2.5_r8*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) + conv_var = conv_var+ 2.5_kp*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) enddo conv_var = conv_var ** oneb3 @@ -1005,7 +1005,7 @@ subroutine eddy_length() wrk = conv_var/(depth*depth*sqrt(tke(i,kk))) & + pt01*brunt2(i,kk)/tke(i,kk) - smixt(i,kk) = min(max_eddy_length_scale, (one/0.3_r8)*sqrt(one/wrk)) + smixt(i,kk) = min(max_eddy_length_scale, (one/0.3_kp)*sqrt(one/wrk)) enddo @@ -1052,7 +1052,7 @@ subroutine conv_scale() !********************************************************************** conv_vel2(i,k) = conv_vel2(i,k-1) & - + 2.5_r8*adzi(i,k)*bet(i,k)*wthv_sec(i,k) + + 2.5_kp*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1083,7 +1083,7 @@ subroutine check_eddy() do i=1,nx - wrk = 0.1_r8*adzl(i,k) + wrk = 0.1_kp*adzl(i,k) ! Minimum 0.1 of local dz smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) @@ -1091,7 +1091,7 @@ subroutine check_eddy() ! be not larger that that. ! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,kb) == zero .and. qcl(i,k) > zero .and. brunt(i,k) > 1.0e-4_r8) then + if (qcl(i,kb) == zero .and. qcl(i,k) > zero .and. brunt(i,k) > 1.0e-4_kp) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz smixt(i,k) = wrk endif @@ -1117,10 +1117,10 @@ subroutine canuto() ! cond, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) - real, parameter :: c=7.0_r8, a0=0.52_r8/(c*c*(c-2.0_r8)), a1=0.87_r8/(c*c), & - a2=0.5_r8/c, a3=0.6_r8/(c*(c-2.0_r8)), a4=2.4_r8/(3.0_r8*c+5.0_r8), & - a5=0.6_r8/(c*(3.0_r8*c+5.0_r8)) -!Moorthi a5=0.6_r8/(c*(3.0_r8+5.0_r8*c)) + real, parameter :: c=7.0_kp, a0=0.52_kp/(c*c*(c-2.0_kp)), a1=0.87_kp/(c*c), & + a2=0.5_kp/c, a3=0.6_kp/(c*(c-2.0_kp)), a4=2.4_kp/(3.0_kp*c+5.0_kp), & + a5=0.6_kp/(c*(3.0_kp*c+5.0_kp)) +!Moorthi a5=0.6_kp/(c*(3.0_kp+5.0_kp*c)) ! do k=1,nzm do k=2,nzm @@ -1210,7 +1210,7 @@ subroutine canuto() omega0 = a4 / (one-a5*buoy_sgs2) omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5.0_r8/4.0_r8)*omega0*f4 + omega2 = omega1*f3+(5.0_kp/4.0_kp)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) @@ -1233,7 +1233,7 @@ subroutine canuto() !aab ! Implemetation of the C01 approach in this subroutine is nearly complete @@ -1287,7 +1287,7 @@ subroutine assumed_pdf() diag_qi = zero pval = prsl(i,k) - pfac = pval * 1.0e-5_r8 + pfac = pval * 1.0e-5_kp pkap = pfac ** kapa ! Read in liquid/ice static energy, total water mixing ratio, @@ -1361,21 +1361,21 @@ subroutine assumed_pdf() ELSE !aab Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi ! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4_r8 - w2_2 = 0.4_r8 + w2_1 = 0.4_kp + w2_2 = 0.4_kp ! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0_r8*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0_kp*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) onema = one - aterm sqrtw2t = sqrt(wrk) @@ -1414,8 +1414,8 @@ subroutine assumed_pdf() ! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 wrk = three * (thl1_2-thl1_1) if (wrk /= zero) then - thl2_1 = thlsec * min(100.0_r8,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - thl2_2 = thlsec * min(100.0_r8,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + thl2_1 = thlsec * min(100.0_kp,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + thl2_2 = thlsec * min(100.0_kp,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 else thl2_1 = zero thl2_2 = zero @@ -1449,12 +1449,12 @@ subroutine assumed_pdf() ! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4_r8) THEN + IF (tsign > 0.4_kp) THEN Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2_r8) THEN + ELSEIF (tsign <= 0.2_kp) THEN Skew_qw = zero ELSE - Skew_qw = (skew_facw/0.2_r8) * Skew_w * (tsign-0.2_r8) + Skew_qw = (skew_facw/0.2_kp) * Skew_w * (tsign-0.2_kp) ENDIF wrk1 = qw1_1 * qw1_1 @@ -1464,8 +1464,8 @@ subroutine assumed_pdf() wrk = three * (qw1_2-qw1_1) if (wrk /= zero) then - qw2_1 = qwsec * min(100.0_r8,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - qw2_2 = qwsec * min(100.0_r8,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + qw2_1 = qwsec * min(100.0_kp,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + qw2_2 = qwsec * min(100.0_kp,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 else qw2_1 = zero qw2_2 = zero @@ -1511,18 +1511,18 @@ subroutine assumed_pdf() IF (Tl1_1 >= tbgmax) THEN lstarn1 = lcond esval = min(fpvsl(Tl1_1), pval) - qs1 = eps * esval / (pval-0.378_r8*esval) + qs1 = eps * esval / (pval-0.378_kp*esval) ELSE IF (Tl1_1 <= tbgmin) THEN lstarn1 = lsub esval = min(fpvsi(Tl1_1), pval) - qs1 = epss * esval / (pval-0.378_r8*esval) + qs1 = epss * esval / (pval-0.378_kp*esval) ELSE om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) lstarn1 = lcond + (one-om1)*lfus esval = min(fpvsl(Tl1_1), pval) esval2 = min(fpvsi(Tl1_1), pval) - qs1 = om1 * eps * esval / (pval-0.378_r8*esval) & - + (one-om1) * epss * esval2 / (pval-0.378_r8*esval2) + qs1 = om1 * eps * esval / (pval-0.378_kp*esval) & + + (one-om1) * epss * esval2 / (pval-0.378_kp*esval2) ENDIF ! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) @@ -1541,18 +1541,18 @@ subroutine assumed_pdf() IF (Tl1_2 >= tbgmax) THEN lstarn2 = lcond esval = min(fpvsl(Tl1_2), pval) - qs2 = eps * esval / (pval-0.378_r8*esval) + qs2 = eps * esval / (pval-0.378_kp*esval) ELSE IF (Tl1_2 <= tbgmin) THEN lstarn2 = lsub esval = min(fpvsi(Tl1_2), pval) - qs2 = epss * esval / (pval-0.378_r8*esval) + qs2 = epss * esval / (pval-0.378_kp*esval) ELSE om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) lstarn2 = lcond + (one-om2)*lfus esval = min(fpvsl(Tl1_2), pval) esval2 = min(fpvsi(Tl1_2), pval) - qs2 = om2 * eps * esval / (pval-0.378_r8*esval) & - + (one-om2) * epss * esval2 / (pval-0.378_r8*esval2) + qs2 = om2 * eps * esval / (pval-0.378_kp*esval) & + + (one-om2) * epss * esval2 / (pval-0.378_kp*esval2) ENDIF ! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 @@ -1662,14 +1662,14 @@ subroutine assumed_pdf() ! Update ncpl and ncpi Moorthi 12/12/2018 if (ntlnc > 0) then ! liquid and ice number concentrations predicted if (ncpl(i,k) > nmin) then - ncpl(i,k) = diag_ql/max(qc(i,k),1.0e-10_r8)*ncpl(i,k) + ncpl(i,k) = diag_ql/max(qc(i,k),1.0e-10_kp)*ncpl(i,k) else - ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0_r8), nmin) + ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0_kp), nmin) endif if (ncpi(i,k) > nmin) then - ncpi(i,k) = diag_qi/max(qi(i,k),1.0e-10_r8)*ncpi(i,k) + ncpi(i,k) = diag_qi/max(qi(i,k),1.0e-10_kp)*ncpi(i,k) else - ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0_r8), nmin) + ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0_kp), nmin) endif endif diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 183365a6e..69690d52e 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -167,14 +167,14 @@ subroutine m_micro_run( im, lm, flipv, dt_i & !------------------------------------ ! input ! real, parameter :: r_air = 3.47d-3 - integer, parameter :: r8 = kind_phys - real, parameter :: one=1.0_r8, oneb3=one/3.0_r8, onebcp=one/cp, & - zero=0.0_r8, half=0.5_r8, onebg=one/grav, & + integer, parameter :: kp = kind_phys + real, parameter :: one=1.0_kp, oneb3=one/3.0_kp, onebcp=one/cp, & + zero=0.0_kp, half=0.5_kp, onebg=one/grav, & & kapa=rgas*onebcp, cpbg=cp/grav, & & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp, & - & qsmall=1.0e-14_r8, rainmin = 1.0e-13_r8, & - & fourb3=4.0_r8/3.0_r8, RL_cub=1.0e-15_r8, & - & nmin=1.0_r8 + & qsmall=1.0e-14_kp, rainmin = 1.0e-13_kp, & + & fourb3=4.0_kp/3.0_kp, RL_cub=1.0e-15_kp, & + & nmin=1.0_kp integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, lm, kdt, fprcp, pdfflag, iccn @@ -229,7 +229,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & integer kcldtopcvn,i,k,ll, kbmin, NAUX, nbincontactdust,l integer, dimension(im) :: kct real (kind=kind_phys) T_ICE_ALL, USE_AV_V,BKGTAU,LCCIRRUS, & - & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, tem, & + & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_kp, tem, & & TMAXLL, USURF,LTS_UP, LTS_LOW, MIN_EXP, fracover, c2_gw, est3 real(kind=kind_phys), allocatable, dimension(:,:) :: & @@ -328,7 +328,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & ncalr8, ncair8, mnuccdor8, nnucctor8, nsoutr8, nroutr8, & & nnuccdor8, nnucccor8,naair8, & & nsacwior8, nsubior8, nprcior8, npraior8, npccnor8, npsacwsor8, & - & nsubcor8, npraor8, nprc1or8, tlatauxr8,pfrz_inc_r8,sadice, & + & nsubcor8, npraor8, nprc1or8, tlatauxr8,pfrz_inc_kp,sadice, & & sadsnow, am_evp_st, reff_rain, reff_snow, & & umr,ums,qrsedten,qssedten,refl,arefl,areflz,frefl,csrfl, & & acsrfl,fcsrfl,rercld,qrout2,qsout2,nrout2,nsout2,drout2, & @@ -348,28 +348,28 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! real (kind=kind_phys), parameter :: disp_liu=2., ui_scale=1.0 & ! &, dcrit=20.0d-6 & - real (kind=kind_phys), parameter :: disp_liu=1.0_r8 & - &, ui_scale=1.0_r8 & - &, dcrit=1.0e-6_r8 & + real (kind=kind_phys), parameter :: disp_liu=1.0_kp & + &, ui_scale=1.0_kp & + &, dcrit=1.0e-6_kp & ! &, ts_autice=1800.0 & ! &, ts_autice=3600.0 & !time scale - &, ninstr8 = 0.1e6_r8 & - &, ncnstr8 = 100.0e6_r8 + &, ninstr8 = 0.1e6_kp & + &, ncnstr8 = 100.0e6_kp - real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_r8 + real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_kp real(kind=kind_phys):: t_ice_denom integer, dimension(1) :: lev_sed_strt ! sedimentation start level - real(kind=kind_phys), parameter :: sig_sed_strt=0.05_r8 ! normalized pressure at sedimentation start + real(kind=kind_phys), parameter :: sig_sed_strt=0.05_kp ! normalized pressure at sedimentation start real(kind=kind_phys),dimension(3) :: ccn_diag real(kind=kind_phys),dimension(58) :: cloudparams integer, parameter :: CCN_PARAM=2, IN_PARAM=5 - real(kind=kind_phys), parameter ::fdust_drop=1.0_r8, fsoot_drop=0.1_r8 & - &, sigma_nuc_r8=0.28_r8,SCLMFDFR=0.03_r8 -! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1 + real(kind=kind_phys), parameter ::fdust_drop=1.0_kp, fsoot_drop=0.1_kp & + &, sigma_nuc_kp=0.28_kp,SCLMFDFR=0.03_kp +! &, sigma_nuc_kp=0.28,SCLMFDFR=0.1 type (AerProps), dimension (IM,LM) :: AeroProps type (AerProps) :: AeroAux, AeroAux_b @@ -383,22 +383,22 @@ subroutine m_micro_run( im, lm, flipv, dt_i & !================== Start Stratiform cloud processes========================================== !set up initial values - data USE_AV_V/1.0_r8/, BKGTAU/0.015_r8/, LCCIRRUS/500.0_r8/, NPRE_FRAC/1.0_r8/, & - & TMAXLL/296.0_r8/, fracover/1.0_r8/, LTS_LOW/12.0_r8/, LTS_UP/24.0_r8/, & - & MIN_EXP/0.5_r8/ + data USE_AV_V/1.0_kp/, BKGTAU/0.015_kp/, LCCIRRUS/500.0_kp/, NPRE_FRAC/1.0_kp/, & + & TMAXLL/296.0_kp/, fracover/1.0_kp/, LTS_LOW/12.0_kp/, LTS_UP/24.0_kp/, & + & MIN_EXP/0.5_kp/ data cloudparams/ & - & 10.0_r8, 4.0_r8 , 4.0_r8 , 1.0_r8 , 2.e-3_r8, 8.e-4_r8, 2.0_r8 , 1.0_r8 , -1.0_r8 & - &, 0.0_r8 , 1.3_r8 , 1.0e-9_r8, 3.3e-4_r8, 20.0_r8 , 4.8_r8 , 4.8_r8 , 230.0_r8 , 1.0_r8 & - &, 1.0_r8 , 230.0_r8, 14400._r8, 50.0_r8 , 0.01_r8 , 0.1_r8 , 200.0_r8, 0.0_r8 , 0.0_r8 & - &, 0.5_r8 , 0.5_r8 , 2000.0_r8, 0.8_r8 , 0.5_r8 , -40.0_r8, 1.0_r8 , 4.0_r8 , 0.0_r8 & - &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 900.0_r8& -! &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 880.0_r8& -! &, 0.0_r8 , 0.0_r8 , 1.0e-3_r8, 8.0e-4_r8, 1.0_r8 , 0.95_r8 , 1.0_r8 , 0.0_r8 , 980.0_r8& - &, 1.0_r8 , 1.0_r8 , 1.0_r8 , 0.0_r8 , 0.0_r8 , 1.e-5_r8, 2.e-5_r8, 2.1e-5_r8, 4.e-5_r8& -! &, 3e-5_r8, 0.1_r8 , 4.0_r8 , 250.0_r8/ ! Annings version - &, 3e-5_r8, 0.1_r8 , 4.0_r8 , 150.0_r8/ ! Annings version -! &, 3e-5_r8, 0.1_r8 , 1.0_r8 , 150.0_r8/ + & 10.0_kp, 4.0_kp , 4.0_kp , 1.0_kp , 2.e-3_kp, 8.e-4_kp, 2.0_kp , 1.0_kp , -1.0_kp & + &, 0.0_kp , 1.3_kp , 1.0e-9_kp, 3.3e-4_kp, 20.0_kp , 4.8_kp , 4.8_kp , 230.0_kp , 1.0_kp & + &, 1.0_kp , 230.0_kp, 14400._kp, 50.0_kp , 0.01_kp , 0.1_kp , 200.0_kp, 0.0_kp , 0.0_kp & + &, 0.5_kp , 0.5_kp , 2000.0_kp, 0.8_kp , 0.5_kp , -40.0_kp, 1.0_kp , 4.0_kp , 0.0_kp & + &, 0.0_kp , 0.0_kp , 1.0e-3_kp, 8.0e-4_kp, 1.0_kp , 0.95_kp , 1.0_kp , 0.0_kp , 900.0_kp& +! &, 0.0_kp , 0.0_kp , 1.0e-3_kp, 8.0e-4_kp, 1.0_kp , 0.95_kp , 1.0_kp , 0.0_kp , 880.0_kp& +! &, 0.0_kp , 0.0_kp , 1.0e-3_kp, 8.0e-4_kp, 1.0_kp , 0.95_kp , 1.0_kp , 0.0_kp , 980.0_kp& + &, 1.0_kp , 1.0_kp , 1.0_kp , 0.0_kp , 0.0_kp , 1.e-5_kp, 2.e-5_kp, 2.1e-5_kp, 4.e-5_kp& +! &, 3e-5_kp, 0.1_kp , 4.0_kp , 250.0_kp/ ! Annings version + &, 3e-5_kp, 0.1_kp , 4.0_kp , 150.0_kp/ ! Annings version +! &, 3e-5_kp, 0.1_kp , 1.0_kp , 150.0_kp/ ! Initialize CCPP error handling variables errmsg = '' @@ -434,7 +434,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,ll) CLCN(I,k) = CLCN_i(I,ll) CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) - PLO(i,k) = prsl_i(i,ll)*0.01_r8 + PLO(i,k) = prsl_i(i,ll)*0.01_kp zlo(i,k) = phil(i,ll) * onebg temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) @@ -449,7 +449,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) * 0.01_r8 ! interface pressure in hPa + PLE(i,k) = prsi_i(i,ll) * 0.01_kp ! interface pressure in hPa zet(i,k+1) = phii(i,ll) * onebg END DO END DO @@ -494,7 +494,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & CNV_DQLDT(I,K) = CNV_DQLDT_i(I,k) CLCN(I,k) = CLCN_i(I,k) CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) - PLO(i,k) = prsl_i(i,k)*0.01_r8 + PLO(i,k) = prsl_i(i,k)*0.01_kp zlo(i,k) = phil(i,k) * onebg temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) @@ -508,7 +508,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & END DO DO K=0, LM DO I = 1,IM - PLE(i,k) = prsi_i(i,k) * 0.01_r8 ! interface pressure in hPa + PLE(i,k) = prsi_i(i,k) * 0.01_kp ! interface pressure in hPa zet(i,k+1) = phii(i,k) * onebg END DO END DO @@ -535,7 +535,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! endif ! DT_MOIST = dt_i - dt_r8 = dt_i + dt_kp = dt_i if (kdt == 1) then DO K=1, LM @@ -547,17 +547,17 @@ subroutine m_micro_run( im, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif enddo @@ -571,8 +571,8 @@ subroutine m_micro_run( im, lm, flipv, dt_i & DO I=1, IM DO K = LM-2, 10, -1 - If ((CNV_DQLDT(I,K) <= 1.0e-9_r8) .and. & - & (CNV_DQLDT(I,K+1) > 1.0e-9_r8)) then + If ((CNV_DQLDT(I,K) <= 1.0e-9_kp) .and. & + & (CNV_DQLDT(I,K+1) > 1.0e-9_kp)) then KCT(I) = K+1 exit end if @@ -652,7 +652,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do l=lm-1,1,-1 do i=1,im tx1 = half * (temp(i,l+1) + temp(i,l)) - kh(i,l) = 3.55e-7_r8*tx1**2.5_r8*(rgas*0.01_r8) / ple(i,l) !kh molecule diff only needing refinement + kh(i,l) = 3.55e-7_kp*tx1**2.5_kp*(rgas*0.01_kp) / ple(i,l) !kh molecule diff only needing refinement enddo end do do i=1,im @@ -661,8 +661,8 @@ subroutine m_micro_run( im, lm, flipv, dt_i & enddo do L=LM,1,-1 do i=1,im - blk_l(i,l) = one / ( one/max(0.15_r8*ZPBL(i),0.4_r8*zlo(i,lm-1))& - & + one/(zlo(i,l)*0.4_r8) ) + blk_l(i,l) = one / ( one/max(0.15_kp*ZPBL(i),0.4_kp*zlo(i,lm-1))& + & + one/(zlo(i,l)*0.4_kp) ) SC_ICE(i,l) = one NCPL(i,l) = MAX( NCPL(i,l), zero) @@ -681,8 +681,8 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do l=1,lm - rhdfdar8(l) = 1.e-8_r8 - rhu00r8(l) = 0.95_r8 + rhdfdar8(l) = 1.e-8_kp + rhu00r8(l) = 0.95_kp ttendr8(l) = zero qtendr8(l) = zero @@ -692,7 +692,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & enddo do k=1,10 do l=1,lm - rndstr8(l,k) = 2.0e-7_r8 + rndstr8(l,k) = 2.0e-7_kp enddo enddo @@ -727,8 +727,8 @@ subroutine m_micro_run( im, lm, flipv, dt_i & if ( iccn == 2) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else - AERMASSMIX(:,:,1:5) = 1.0e-6_r8 - AERMASSMIX(:,:,6:15) = 2.0e-14_r8 + AERMASSMIX(:,:,1:5) = 1.0e-6_kp + AERMASSMIX(:,:,6:15) = 2.0e-14_kp end if !> - Call aerconversion1() call AerConversion1 (AERMASSMIX, AeroProps) @@ -747,23 +747,23 @@ subroutine m_micro_run( im, lm, flipv, dt_i & kcldtopcvn = KCT(I) tausurf_gw = min(half*SQRT(TAUOROX(I)*TAUOROX(I) & - & + TAUOROY(I)*TAUOROY(I)), 10.0_r8) + & + TAUOROY(I)*TAUOROY(I)), 10.0_kp) do k=1,lm uwind_gw(k) = min(half*SQRT( U1(I,k)*U1(I,k) & - & + V1(I,k)*V1(I,k)), 50.0_r8) + & + V1(I,k)*V1(I,k)), 50.0_kp) ! tausurf_gw =tausurf_gw + max (tausurf_gw, min(0.5*SQRT(TAUX(I , J)**2+TAUY(I , J)**2), 10.0)*BKGTAU) !adds a minimum value from unresolved sources - pm_gw(k) = 100.0_r8*PLO(I,k) + pm_gw(k) = 100.0_kp*PLO(I,k) tm_gw(k) = TEMP(I,k) nm_gw(k) = zero rho_gw(k) = pm_gw(k) /(RGAS*tm_gw(k)) ter8(k) = TEMP(I,k) - plevr8(k) = 100.0_r8*PLO(I,k) + plevr8(k) = 100.0_kp*PLO(I,k) ndropr8(k) = NCPL(I,k) qir8(k) = QILS(I,k) + QICN(I,k) qcr8(k) = QLLS(I,k) + QLCN(I,k) @@ -774,27 +774,27 @@ subroutine m_micro_run( im, lm, flipv, dt_i & npre8(k) = zero - if (RAD_CF(I,k) > 0.01_r8 .and. qir8(k) > zero) then + if (RAD_CF(I,k) > 0.01_kp .and. qir8(k) > zero) then npre8(k) = NPRE_FRAC*NCPI(I,k) else npre8(k) = zero endif omegr8(k) = OMEGA(I,k) - lc_turb(k) = max(blk_l(I,k), 50.0_r8) + lc_turb(k) = max(blk_l(I,k), 50.0_kp) ! rad_cooling(k) = RADheat(I,k) if (npre8(k) > zero .and. qir8(k) > zero) then - dpre8(k) = ( qir8(k)/(6.0_r8*npre8(k)*900.0_r8*PI))**(one/3.0_r8) + dpre8(k) = ( qir8(k)/(6.0_kp*npre8(k)*900.0_kp*PI))**(one/3.0_kp) else - dpre8(k) = 1.0e-9_r8 + dpre8(k) = 1.0e-9_kp endif wparc_ls(k) = -omegr8(k) / (rho_gw(k)*GRAV) & & + cpbg * radheat(i,k) ! & + cpbg * rad_cooling(k) enddo do k=0,lm - pi_gw(k) = 100.0_r8*PLE(I,k) + pi_gw(k) = 100.0_kp*PLE(I,k) rhoi_gw(k) = zero ni_gw(k) = zero ti_gw(k) = zero @@ -810,13 +810,13 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & ti_gw, nm_gw, q1(i,:)) do k=1,lm - nm_gw(k) = max(nm_gw(k), 0.005_r8) + nm_gw(k) = max(nm_gw(k), 0.005_kp) h_gw(k) = k_gw*rho_gw(k)*uwind_gw(k)*nm_gw(k) if (h_gw(K) > zero) then - h_gw(K) = sqrt(2.0_r8*tausurf_gw/h_gw(K)) + h_gw(K) = sqrt(2.0_kp*tausurf_gw/h_gw(K)) end if - wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133_r8 + wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133_kp wparc_cgw(k) = zero end do @@ -833,14 +833,14 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do k=1,kcldtopcvn c2_gw = (nm_gw(k) + Nct) / Nct - wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56_r8* & - & 1.806_r8*c2_gw*c2_gw)*Wct*0.133_r8 + wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56_kp* & + & 1.806_kp*c2_gw*c2_gw)*Wct*0.133_kp enddo end if do k=1,lm - dummyW(k) = 0.133_r8*k_gw*uwind_gw(k)/nm_gw(k) + dummyW(k) = 0.133_kp*k_gw*uwind_gw(k)/nm_gw(k) enddo do K=1, LM-5, 1 @@ -860,17 +860,17 @@ subroutine m_micro_run( im, lm, flipv, dt_i & kbmin = min(kbmin, LM-1) - 4 do K = 1, LM wparc_turb(k) = KH(I,k) / lc_turb(k) - dummyW(k) = 10.0_r8 + dummyW(k) = 10.0_kp enddo - if (FRLAND(I) < 0.1_r8 .and. ZPBL(I) < 800.0_r8 .and. & - & TEMP(I,LM) < 298.0_r8 .and. TEMP(I,LM) > 274.0_r8) then + if (FRLAND(I) < 0.1_kp .and. ZPBL(I) < 800.0_kp .and. & + & TEMP(I,LM) < 298.0_kp .and. TEMP(I,LM) > 274.0_kp) then do K = 1, LM - dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01_r8, 10.0_r8),-10.0_r8) + dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01_kp, 10.0_kp),-10.0_kp) dummyW(k) = one / (one+exp(dummyW(k))) enddo maxkh = max(maxval(KH(I,kbmin:LM-1)*nm_gw(kbmin:LM-1)/ & - & 0.17_r8), 0.3_r8) + & 0.17_kp), 0.3_kp) do K = 1, LM wparc_turb(k) = (one-dummyW(k))*wparc_turb(k) & & + dummyW(k)*maxkh @@ -878,7 +878,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & end if - wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2_r8) + wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2_kp) @@ -896,11 +896,11 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do K = 1, LM - if (plevr8(K) > 70.0_r8) then + if (plevr8(K) > 70.0_kp) then - ccn_diag(1) = 0.001_r8 - ccn_diag(2) = 0.004_r8 - ccn_diag(3) = 0.01_r8 + ccn_diag(1) = 0.001_kp + ccn_diag(2) = 0.004_kp + ccn_diag(3) = 0.01_kp if (K > 2 .and. K <= LM-2) then tauxr8 = (ter8(K-1) + ter8(K+1) + ter8(K)) * oneb3 @@ -915,8 +915,8 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! call init_Aer(AeroAux_b) ! endif - pfrz_inc_r8(k) = zero - rh1_r8 = zero !related to cnv_dql_dt, needed to changed soon + pfrz_inc_kp(k) = zero + rh1_kp = zero !related to cnv_dql_dt, needed to changed soon ! if (lprnt) write(0,*)' bef aero npccninr8=',npccninr8(k),' k=',k & ! &,' ccn_param=',ccn_param,' in_param=',in_param & @@ -932,12 +932,12 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & sc_icer8(k), dust_immr8(K), dust_depr8(k), & & dust_dhfr8(k), nlimicer8(k), use_average_v, & & CCN_PARAM, IN_PARAM, fdust_drop, & - & fsoot_drop,pfrz_inc_r8(K),sigma_nuc_r8, rh1_r8, & + & fsoot_drop,pfrz_inc_kp(K),sigma_nuc_kp, rh1_kp, & & size(ccn_diag)) ! & size(ccn_diag), lprnt) ! if (lprnt) write(0,*)' aft aero npccninr8=',npccninr8(k),' k=',k - if (npccninr8(k) < 1.0e-12_r8) npccninr8(k) = zero + if (npccninr8(k) < 1.0e-12_kp) npccninr8(k) = zero ! CCN01(I,K) = max(ccn_diag(1)*1e-6, 0.0) ! CCN04(I,K) = max(ccn_diag(2)*1e-6, 0.0) @@ -951,7 +951,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & swparc(K) = zero smaxicer8(K) = zero nheticer8(K) = zero - sc_icer8(K) = 2.0_r8 + sc_icer8(K) = 2.0_kp ! sc_icer8(K) = 1.0d0 naair8(K) = zero npccninr8(K) = zero @@ -968,9 +968,9 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! SMAXL(I,k) = smaxliq(k) * 100.0 ! SMAXI(I,k) = smaxicer8(k) * 100.0 - NHET_NUC(I,k) = nheticer8(k) * 1.0e-6_r8 - NLIM_NUC(I,k) = nlimicer8(k) * 1.0e-6_r8 - SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0_r8) + NHET_NUC(I,k) = nheticer8(k) * 1.0e-6_kp + NLIM_NUC(I,k) = nlimicer8(k) * 1.0e-6_kp + SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0_kp) ! SC_ICE(I,k) = min(max(sc_icer8(k),1.0),1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) @@ -980,13 +980,13 @@ subroutine m_micro_run( im, lm, flipv, dt_i & if (iccn == 0) then if(temp(i,k) < T_ICE_ALL) then ! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5_r8) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5_kp) elseif(temp(i,k) > TICE) then SC_ICE(i,k) = rhc(i,k) else ! SC_ICE(i,k) = 1.0 ! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5_r8) + tx1 = max(SC_ICE(I,k), 1.5_kp) SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & * t_ice_denom endif @@ -997,12 +997,12 @@ subroutine m_micro_run( im, lm, flipv, dt_i & endif NHET_IMM(I,k) = max(nhet_immr8(k), zero) DNHET_IMM(I,k) = max(dnhet_immr8(k), zero) - NHET_DEP(I,k) = nhet_depr8(k) * 1.0e-6_r8 - NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0e-6_r8 - DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0e-6_r8 - DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0e-6_r8 - DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0e-6_r8 - WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8_r8 + NHET_DEP(I,k) = nhet_depr8(k) * 1.0e-6_kp + NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0e-6_kp + DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0e-6_kp + DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0e-6_kp + DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0e-6_kp + WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8_kp SIGW_GW (I,k) = wparc_gw(k) * wparc_gw(k) SIGW_CNV (I,k) = wparc_cgw(k) * wparc_cgw(k) SIGW_TURB (I,k) = wparc_turb(k) * wparc_turb(k) @@ -1115,7 +1115,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do k=1,lm do i=1,im - if (CNV_MFD(i,k) > 1.0e-6_r8) then + if (CNV_MFD(i,k) > 1.0e-6_kp) then tx1 = one / CNV_MFD(i,k) CNV_NDROP(i,k) = CNV_NDROP(i,k) * tx1 CNV_NICE(i,k) = CNV_NICE(i,k) * tx1 @@ -1224,7 +1224,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & do l=1,10 do k=1,lm naconr8(k,l) = zero - rndstr8(k,l) = 2.0e-7_r8 + rndstr8(k,l) = 2.0e-7_kp enddo enddo do k=1,lm @@ -1235,7 +1235,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! tx1 = MIN(CLLS(I,k) + CLCN(I,k), 0.99) tx1 = MIN(CLLS(I,k) + CLCN(I,k), one) if (tx1 > zero) then - cldfr8(k) = min(max(tx1, 0.00001_r8), one) + cldfr8(k) = min(max(tx1, 0.00001_kp), one) else cldfr8(k) = zero endif @@ -1271,7 +1271,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & naair8(k) = INC_NUC(I,k) npccninr8(k) = CDNC_NUC(I,k) - if (cldfr8(k) >= 0.001_r8) then + if (cldfr8(k) >= 0.001_kp) then nimmr8(k) = min(DNHET_IMM(I,k),ncr8(k)/(cldfr8(k)*DT_MOIST)) else nimmr8(k) = zero @@ -1299,11 +1299,11 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! naux = AeroAux_b%nmods ! rnsootr8 (K) = sum(AeroAux_b%dpg(1:naux))/naux - pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0_r8 + pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0_kp rpdelr8(k) = one / pdelr8(k) - plevr8(k) = 100.0_r8 * PLO(I,k) + plevr8(k) = 100.0_kp * PLO(I,k) zmr8(k) = ZLO(I,k) - ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0e-10_r8) + ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0e-10_kp) omegr8(k) = WSUB(I,k) ! alphar8(k) = max(alpht_x(i,k)/maxval(alpht_x(i,:))*8.,0.5) ! alphar8(k) = qcvar2 @@ -1311,7 +1311,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & END DO do k=1,lm+1 - pintr8(k) = PLE(I,k-1) * 100.0_r8 + pintr8(k) = PLE(I,k-1) * 100.0_kp kkvhr8(k) = KH(I,k-1) END DO @@ -1358,7 +1358,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & enddo call mmicro_pcond ( ncolmicro, ncolmicro, & - & dt_r8, ter8, ttendr8, & + & dt_kp, ter8, ttendr8, & & ncolmicro, LM , qvr8, & & qtendr8, cwtendr8, qcr8, qir8, ncr8, nir8, & & abs(fprcp), qrr8, qsr8, nrr8, nsr8, & @@ -1396,29 +1396,29 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! if (lprint) write(0,*)' prectr8=',prectr8(1), & ! & ' precir8=',precir8(1) - LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_r8*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kp*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kp*precir8(1), zero) do k=1,lm - QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 - QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 - Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_R8 + QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_kp + QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_kp + Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_kp ! if(lprnt .and. i == ipr) write(0,*)' k=',k,' q1aftm=',q1(i,k) & ! &,' qvlatr8=',qvlatr8(k) - TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_R8*onebcp + TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_kp*onebcp - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_R8, zero) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_R8, zero) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_kp, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_kp, zero) rnw(I,k) = qrr8(k) snw(I,k) = qsr8(k) NCPR(I,k) = nrr8(k) NCPS(I,k) = nsr8(k) - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) - CLDREFFR(I,k) = max(droutr8(k)*0.5_r8*1.0e6_r8, 150.0_r8) - CLDREFFS(I,k) = max(0.192_r8*dsoutr8(k)*0.5_r8*1.0e6_r8, 250.0_r8) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kp), 150.0_kp) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kp), 150.0_kp) + CLDREFFR(I,k) = max(droutr8(k)*0.5_kp*1.0e6_kp, 150.0_kp) + CLDREFFS(I,k) = max(0.192_kp*dsoutr8(k)*0.5_kp*1.0e6_kp, 250.0_kp) enddo ! K loop @@ -1426,7 +1426,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! -------- ! if (lprnt .and. i == ipr) then ! write(0,*)' bef micro_mg_tend ter8= ', ter8(:) -! write(0,*)' bef micro_mg_tend qvr8= ', qvr8(:),'dt_r8=',dt_r8 +! write(0,*)' bef micro_mg_tend qvr8= ', qvr8(:),'dt_kp=',dt_kp ! write(0,*)' bef micro_mg_tend rhr8= ', rhr8(:) ! endif lprint = lprnt .and. i == ipr @@ -1445,7 +1445,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! endif call micro_mg_tend2_0 ( & - & ncolmicro, lm, dt_r8, & + & ncolmicro, lm, dt_kp, & & ter8, qvr8, & & qcr8, qir8, & & ncr8, nir8, & @@ -1500,25 +1500,25 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_r8*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kp*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kp*precir8(1), zero) do k=1,lm - QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 - QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 - Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_R8 - TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_R8*onebcp - rnw(I,k) = rnw(I,k) + qrtend(k)*dt_r8 - snw(I,k) = snw(I,k) + qstend(k)*dt_r8 - - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) - CLDREFFR(I,k) = max(reff_rain(k), 150.0_r8) - CLDREFFS(I,k) = max(reff_snow(k), 250.0_r8) + QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_kp + QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_kp + Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_kp + TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_kp*onebcp + rnw(I,k) = rnw(I,k) + qrtend(k)*dt_kp + snw(I,k) = snw(I,k) + qstend(k)*dt_kp + + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_kp, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_kp, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_kp, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_kp, zero) + + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kp), 150.0_kp) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kp), 150.0_kp) + CLDREFFR(I,k) = max(reff_rain(k), 150.0_kp) + CLDREFFS(I,k) = max(reff_snow(k), 250.0_kp) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1529,10 +1529,10 @@ subroutine m_micro_run( im, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0_r8 - CLDREFFI(I,k) = 50.0_r8 - CLDREFFR(I,k) = 1000.0_r8 - CLDREFFS(I,k) = 250.0_r8 + CLDREFFL(I,k) = 10.0_kp + CLDREFFI(I,k) = 50.0_kp + CLDREFFR(I,k) = 1000.0_kp + CLDREFFS(I,k) = 250.0_kp enddo ! K loop endif ! @@ -1558,7 +1558,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & !> - Call micro_mg3_0::micro_mg_tend(), which is the main microphysics routine to !! calculate microphysical processes and other utilities. call micro_mg_tend3_0 ( & - & ncolmicro, lm, dt_r8, & + & ncolmicro, lm, dt_kp, & & ter8, qvr8, & & qcr8, qir8, & & ncr8, nir8, & @@ -1637,28 +1637,28 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) - LS_PRC2(I) = max(1000.0_r8*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.0_r8*precir8(1), zero) + LS_PRC2(I) = max(1000.0_kp*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0_kp*precir8(1), zero) do k=1,lm - QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 - QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 - Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_R8 - TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_R8*onebcp - rnw(I,k) = rnw(I,k) + qrtend(k)*dt_r8 - snw(I,k) = snw(I,k) + qstend(k)*dt_r8 - qgl(I,k) = qgl(I,k) + qgtend(k)*dt_r8 - - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, zero) - - CLDREFFL(I,k) = min(max(effcr8(k), 10.0_r8), 150.0_r8) - CLDREFFI(I,k) = min(max(effir8(k), 20.0_r8), 150.0_r8) - CLDREFFR(I,k) = max(reff_rain(k), 150.0_r8) - CLDREFFS(I,k) = max(reff_snow(k), 250.0_r8) - CLDREFFG(I,k) = max(reff_grau(k), 250.0_r8) + QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_kp + QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_kp + Q1(I,k) = Q1(I,k) + qvlatr8(k)*DT_kp + TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_kp*onebcp + rnw(I,k) = rnw(I,k) + qrtend(k)*dt_kp + snw(I,k) = snw(I,k) + qstend(k)*dt_kp + qgl(I,k) = qgl(I,k) + qgtend(k)*dt_kp + + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_kp, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_kp, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_kp, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_kp, zero) + NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_kp, zero) + + CLDREFFL(I,k) = min(max(effcr8(k), 10.0_kp), 150.0_kp) + CLDREFFI(I,k) = min(max(effir8(k), 20.0_kp), 150.0_kp) + CLDREFFR(I,k) = max(reff_rain(k), 150.0_kp) + CLDREFFS(I,k) = max(reff_snow(k), 250.0_kp) + CLDREFFG(I,k) = max(reff_grau(k), 250.0_kp) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1669,11 +1669,11 @@ subroutine m_micro_run( im, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10.0_r8 - CLDREFFI(I,k) = 50.0_r8 - CLDREFFR(I,k) = 1000.0_r8 - CLDREFFS(I,k) = 250.0_r8 - CLDREFFG(I,k) = 250.0_r8 + CLDREFFL(I,k) = 10.0_kp + CLDREFFI(I,k) = 50.0_kp + CLDREFFR(I,k) = 1000.0_kp + CLDREFFS(I,k) = 250.0_kp + CLDREFFG(I,k) = 250.0_kp enddo ! K loop endif endif @@ -1701,17 +1701,17 @@ subroutine m_micro_run( im, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif enddo enddo @@ -1741,17 +1741,17 @@ subroutine m_micro_run( im, lm, flipv, dt_i & if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_r8), nmin) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_r8), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif enddo enddo @@ -1843,7 +1843,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) - rn_o(i) = tx1 * dt_i * 0.001_r8 + rn_o(i) = tx1 * dt_i * 0.001_kp if (rn_o(i) < rainmin) then sr_o(i) = zero @@ -1896,7 +1896,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & use physcons, grav => con_g, cp => con_cp, rgas => con_rd, & fv => con_fvirt implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys !----------------------------------------------------------------------- ! Compute profiles of background state quantities for the multiple ! gravity wave drag parameterization. @@ -1920,7 +1920,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & real(kind=kind_phys), intent(out) :: nm(pcols,pver) real(kind=kind_phys), parameter :: r=rgas, cpair=cp, g=grav, & - oneocp=1.0_r8/cp, n2min=1.0e-8_r8 + oneocp=1.0_kp/cp, n2min=1.0e-8_kp !---------------------------Local storage------------------------------- integer :: ix,kx @@ -1936,15 +1936,15 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = 0 do ix = 1, ncol ti(ix,kx) = t(ix,kx+1) - rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0_r8+fv*sph(ix,kx+1)))) + rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0_kp+fv*sph(ix,kx+1)))) ni(ix,kx) = sqrt (g*g / (cpair*ti(ix,kx))) end do ! Interior points use centered differences do kx = 1, pver-1 do ix = 1, ncol - ti(ix,kx) = 0.5_r8 * (t(ix,kx) + t(ix,kx+1)) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_r8+0.5_r8*fv*(sph(ix,kx)+sph(ix,kx+1)))) + ti(ix,kx) = 0.5_kp * (t(ix,kx) + t(ix,kx+1)) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_kp+0.5_kp*fv*(sph(ix,kx)+sph(ix,kx+1)))) dtdp = (t(ix,kx+1)-t(ix,kx)) / (pm(ix,kx+1)-pm(ix,kx)) n2 = g*g/ti(ix,kx) * (oneocp - rhoi(ix,kx)*dtdp) ni(ix,kx) = sqrt (max (n2min, n2)) @@ -1956,7 +1956,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = pver do ix = 1, ncol ti(ix,kx) = t(ix,kx) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_r8+fv*sph(ix,kx))) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0_kp+fv*sph(ix,kx))) ni(ix,kx) = ni(ix,kx-1) end do @@ -1965,7 +1965,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & !----------------------------------------------------------------------------- do kx=1,pver do ix=1,ncol - nm(ix,kx) = 0.5_r8 * (ni(ix,kx-1) + ni(ix,kx)) + nm(ix,kx) = 0.5_kp * (ni(ix,kx-1) + ni(ix,kx)) end do end do diff --git a/physics/moninshoc.f b/physics/moninshoc.f index cb15fa301..275d979fe 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -71,7 +71,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! locals ! - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer i,is,k,kk,km1,kmpbl,kp1, ntloc ! logical pblflg(im), sfcflg(im), flg(im) @@ -92,23 +92,23 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, ttend, utend, vtend, qtend &, spdk2, rbint, ri, zol1, robn, bvf2 ! - real(kind=kind_phys), parameter :: one=1.0_r8, zero=0.0_r8 - &, zolcr=0.2_r8, - & zolcru=-0.5_r8, rimin=-100.0_r8, sfcfrac=0.1_r8, - & crbcon=0.25_r8, crbmin=0.15_r8, crbmax=0.35_r8, - & qmin=1.0e-8_r8, zfmin=1.0d-8, qlmin=1.0e-12_r8, - & aphi5=5.0_r8, aphi16=16.0_r8, f0=1.0e-4_r8 - &, dkmin=zero, dkmax=1000.0_r8 + real(kind=kind_phys), parameter :: one=1.0_kp, zero=0.0_kp + &, zolcr=0.2_kp, + & zolcru=-0.5_kp, rimin=-100.0_kp, sfcfrac=0.1_kp, + & crbcon=0.25_kp, crbmin=0.15_kp, crbmax=0.35_kp, + & qmin=1.0e-8_kp, zfmin=1.0d-8, qlmin=1.0e-12_kp, + & aphi5=5.0_kp, aphi16=16.0_kp, f0=1.0e-4_kp + &, dkmin=zero, dkmax=1000.0_kp ! &, dkmin=zero, dkmax=1000., xkzminv=0.3 - &, prmin=0.25_r8, prmax=4.0_r8, vk=0.4_r8, - & cfac=6.5_r8 + &, prmin=0.25_kp, prmax=4.0_kp, vk=0.4_kp, + & cfac=6.5_kp real(kind=kind_phys) :: gravi, cont, conq, gocp, go2 gravi = one / grav cont = cp * gravi conq = hvap * gravi gocp = grav / cp - go2 = grav * 0.5_r8 + go2 = grav * 0.5_kp ! Initialize CCPP error handling variables errmsg = '' @@ -155,7 +155,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (k <= kinver(i)) then ! vertical background diffusivity for heat and momentum tem1 = one - prsi(i,k+1) * tx1(i) - tem1 = min(one, exp(-tem1 * tem1 * 10.0_r8)) + tem1 = min(one, exp(-tem1 * tem1 * 10.0_kp)) xkzo(i,k) = xkzm_h * tem1 xkzmo(i,k) = xkzm_m * tem1 endif @@ -166,9 +166,9 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,kmpbl do i=1,im - if(zi(i,k+1) > 250.0_r8) then + if(zi(i,k+1) > 250.0_kp) then tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.0e-5_r8) then + if(tem1 > 1.0e-5_kp) then xkzo(i,k) = min(xkzo(i,k),xkzminv) endif endif @@ -177,7 +177,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! do i = 1,im - z0(i) = 0.01_r8 * zorl(i) + z0(i) = 0.01_kp * zorl(i) kpbl(i) = 1 hpbl(i) = zi(i,1) pblflg(i) = .true. @@ -224,8 +224,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, thermal(i) = tsea(i)*(one+fv*max(q1(i,1,1),qmin)) tem = max(one, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) robn = tem / (f0 * z0(i)) - tem1 = 1.0e-7_r8 * robn - crb(i) = max(min(0.16_r8 * (tem1 ** (-0.18_r8)), crbmax), + tem1 = 1.0e-7_kp * robn + crb(i) = max(min(0.16_kp * (tem1 ** (-0.18_kp)), crbmax), & crbmin) endif enddo @@ -272,7 +272,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (sfcflg(i)) then ! phim(i) = (1.-aphi16*zol1)**(-1./4.) ! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = one / max(one - aphi16*zol1, 1.0e-8_r8) + tem = one / max(one - aphi16*zol1, 1.0e-8_kp) phih(i) = sqrt(tem) phim(i) = sqrt(phih(i)) else @@ -351,7 +351,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if(ri < zero) then ! unstable regime prnum(i,kp1) = one else - prnum(i,kp1) = min(one + 2.1_r8*ri, prmax) + prnum(i,kp1) = min(one + 2.1_kp*ri, prmax) endif elseif (k > 1) then prnum(i,kp1) = prnum(i,1) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 280ff6386..1c311e4cf 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -10,38 +10,38 @@ module rascnv private logical :: is_initialized = .False. ! - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 - real (kind=kind_phys), parameter :: delt_c=1800.0_r8/3600.0_r8 & + real (kind=kind_phys), parameter :: delt_c=1800.0_kp/3600.0_kp & ! Adjustment time scales in hrs for deep and shallow clouds ! &, adjts_d=3.0, adjts_s=0.5 ! &, adjts_d=2.5, adjts_s=0.5 - &, adjts_d=2.0_r8, adjts_s=0.5_r8 + &, adjts_d=2.0_kp, adjts_s=0.5_kp ! logical, parameter :: fix_ncld_hr=.true. ! - real (kind=kind_phys), parameter :: ZERO=0.0_r8, HALF=0.5_r8 & - &, pt25=0.25_r8, ONE=1.0_r8 & - &, TWO=2.0_r8, FOUR=4.0_r8 & - &, twoo3=two/3.0_r8 & - &, FOUR_P2=4.0e2_r8, ONE_M10=1.0e-10_r8& - &, ONE_M6=1.0e-6_r8, ONE_M5=1.0e-5_r8 & - &, ONE_M2=1.0e-2_r8, ONE_M1=1.0e-1_r8 & - &, oneolog10=one/log(10.0_r8) & - &, facmb = 0.01_r8 & ! conversion factor from Pa to hPa (or mb) - &, cmb2pa = 100.0_r8 ! Conversion from hPa to Pa -! - real(kind=kind_phys), parameter :: frac=0.5_r8, crtmsf=0.0_r8 & - &, rhfacs=0.75_r8, rhfacl=0.75_r8 & - &, face=5.0_r8, delx=10000.0_r8& - &, ddfac=face*delx*0.001_r8 & - &, max_neg_bouy=0.15_r8 & -! &, max_neg_bouy=pt25_r8 & - &, testmb=0.1_r8, testmbi=one/testmb & - &, dpd=0.5_r8, rknob=1.0_r8, eknob=1.0_r8 + real (kind=kind_phys), parameter :: ZERO=0.0_kp, HALF=0.5_kp & + &, pt25=0.25_kp, ONE=1.0_kp & + &, TWO=2.0_kp, FOUR=4.0_kp & + &, twoo3=two/3.0_kp & + &, FOUR_P2=4.0e2_kp, ONE_M10=1.0e-10_kp& + &, ONE_M6=1.0e-6_kp, ONE_M5=1.0e-5_kp & + &, ONE_M2=1.0e-2_kp, ONE_M1=1.0e-1_kp & + &, oneolog10=one/log(10.0_kp) & + &, facmb = 0.01_kp & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa = 100.0_kp ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: frac=0.5_kp, crtmsf=0.0_kp & + &, rhfacs=0.75_kp, rhfacl=0.75_kp & + &, face=5.0_kp, delx=10000.0_kp& + &, ddfac=face*delx*0.001_kp & + &, max_neg_bouy=0.15_kp & +! &, max_neg_bouy=pt25_kp & + &, testmb=0.1_kp, testmbi=one/testmb & + &, dpd=0.5_kp, rknob=1.0_kp, eknob=1.0_kp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! logical, parameter :: do_aw=.true., cumfrc=.true. & @@ -53,17 +53,17 @@ module rascnv ! &, advcld=.true., advups=.false.,advtvd=.false. - real(kind=kind_phys), parameter :: TF=233.16_r8, TCR=273.16_r8 & - &, TCRF=one/(TCR-TF), TCL=2.0_r8 + real(kind=kind_phys), parameter :: TF=233.16_kp, TCR=273.16_kp & + &, TCRF=one/(TCR-TF), TCL=2.0_kp ! ! For pressure gradient force in momentum mixing ! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & ! No pressure gradient force in momentum mixing - real (kind=kind_phys), parameter :: pgftop=0.0_r8, pgfbot=0.0_r8 & + real (kind=kind_phys), parameter :: pgftop=0.0_kp, pgfbot=0.0_kp & ! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & - &, pgfgrad=(pgfbot-pgftop)*0.001_r8& - &, cfmax=0.1_r8 + &, pgfgrad=(pgfbot-pgftop)*0.001_kp& + &, cfmax=0.1_kp ! ! For Tilting Angle Specification ! @@ -121,7 +121,7 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! - real(kind=kind_phys), parameter :: actp=1.7_r8, facm=1.00_r8 + real(kind=kind_phys), parameter :: actp=1.7_kp, facm=1.00_kp ! real(kind=kind_phys) PH(15), A(15) ! @@ -168,7 +168,7 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & ! ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! - AFC = -(1.01097e-4_r8*DT)*(3600.0_r8/DT)**0.57777778_r8 + AFC = -(1.01097e-4_kp*DT)*(3600.0_kp/DT)**0.57777778_kp ! grav = con_g ; cp = con_cp ; alhl = con_hvap alhf = con_hfus ; rgas = con_rd @@ -180,15 +180,15 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & pi = four*atan(one) ; PIINV = one/PI ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA - rkap = rgas * onebcp ; deg2rad = pi/180.0_r8 + rkap = rgas * onebcp ; deg2rad = pi/180.0_kp ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS - picon = half*pi*onebg ; zfac = 0.28888889e-4_r8 * ONEBG + picon = half*pi*onebg ; zfac = 0.28888889e-4_kp * ONEBG testmboalhl = testmb/alhl ! rvi = one/rv ; facw=CVAP-CLIQ faci = CVAP-CSOL ; hsub=alhl+alhf - tmix = TTP-20.0_r8 ; DEN=one/(TTP-TMIX) + tmix = TTP-20.0_kp ; DEN=one/(TTP-TMIX) ! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & @@ -365,7 +365,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & integer, dimension(100) :: ic - real(kind=kind_phys), parameter :: clwmin=1.0e-10_r8 + real(kind=kind_phys), parameter :: clwmin=1.0e-10_kp ! real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & &, trcfac(:,:), rcu(:,:) @@ -392,8 +392,8 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & fscav_(i) = fscav(i) enddo endif - trcmin = -99999.0_r8 - if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_r8 + trcmin = -99999.0_kp + if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_kp !> - Initialize CCPP error handling variables @@ -487,23 +487,23 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & if (flipv) ll = kp1 -l ! Input variables are bottom to top! SGC = prsl(ipt,ll) * tem sgcs(l,ipt) = sgc - IF (SGC <= 0.050_r8) KRMIN = L -! IF (SGC <= 0.700_r8) KRMAX = L -! IF (SGC <= 0.800_r8) KRMAX = L - IF (SGC <= 0.760_r8) KRMAX = L -! IF (SGC <= 0.930_r8) KFMAX = L - IF (SGC <= 0.970_r8) KFMAX = L ! Commented on 20060202 -! IF (SGC <= 0.700_r8) kblmx = L ! Commented on 20101015 - IF (SGC <= 0.600_r8) kblmx = L ! -! IF (SGC <= 0.650_r8) kblmx = L ! Commented on 20060202 - IF (SGC <= 0.980_r8) kblmn = L ! + IF (SGC <= 0.050_kp) KRMIN = L +! IF (SGC <= 0.700_kp) KRMAX = L +! IF (SGC <= 0.800_kp) KRMAX = L + IF (SGC <= 0.760_kp) KRMAX = L +! IF (SGC <= 0.930_kp) KFMAX = L + IF (SGC <= 0.970_kp) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700_kp) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600_kp) kblmx = L ! +! IF (SGC <= 0.650_kp) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980_kp) kblmn = L ! ENDDO krmin = max(krmin,2) ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 - NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001_r8 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001_kp ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 @@ -513,7 +513,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & facdt = delt_c / dt else NCRND = min(nrcmax, (KRMAX-KRMIN+1)) - facdt = one / 3600.0_r8 + facdt = one / 3600.0_kp endif NCRND = min(nrcm,max(NCRND, 1)) ! @@ -537,7 +537,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & IF (NCRND > 0) THEN DO I=1,NCRND II = mod(i-1,nrcm) + 1 - IRND = (RANNUM(ipt,II)-0.0005_r8)*(KCR-KRMIN+1) + IRND = (RANNUM(ipt,II)-0.0005_kp)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF @@ -582,7 +582,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,ll,n+2) - if (abs(uvi(l,n)) < 1.0e-20_r8) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0e-20_kp) uvi(l,n) = zero enddo endif enddo @@ -593,7 +593,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & phi_h(LL) = phii(ipt,L) enddo ! - if (ccin(ipt,1,2) <= -998.0_r8) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0_kp) then ! input ice/water are together do l=1,k ll = kp1 -l tem = ccin(ipt,ll,1) & @@ -631,7 +631,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & if (ntr > 0) then ! tracers such as O3, dust etc do n=1,ntr uvi(l,n) = ccin(ipt,l,n+2) - if (abs(uvi(l,n)) < 1.0e-20_r8) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0e-20_kp) uvi(l,n) = zero enddo endif enddo @@ -641,7 +641,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & phi_h(L) = phii(ipt,L) ENDDO ! - if (ccin(ipt,1,2) <= -998.0_r8) then ! input ice/water are together + if (ccin(ipt,1,2) <= -998.0_kp) then ! input ice/water are together do l=1,k tem = ccin(ipt,l,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) @@ -688,7 +688,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd=',dtvd(:,1) - if (abs(dtvd(2,1)) > 1.0e-10_r8) then + if (abs(dtvd(2,1)) > 1.0e-10_kp) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h @@ -702,7 +702,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) - if (abs(dtvd(2,2)) > 1.0e-10_r8) then + if (abs(dtvd(2,2)) > 1.0e-10_kp) then tem1 = dtvd(1,2) / dtvd(2,2) tem2 = abs(tem1) alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q @@ -713,7 +713,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) - if (abs(dtvd(2,3)) > 1.0e-10_r8) then + if (abs(dtvd(2,3)) > 1.0e-10_kp) then tem1 = dtvd(1,3) / dtvd(2,3) tem2 = abs(tem1) alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql @@ -724,7 +724,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) - if (abs(dtvd(2,4)) > 1.0e-10_r8) then + if (abs(dtvd(2,4)) > 1.0e-10_kp) then tem1 = dtvd(1,4) / dtvd(2,4) tem2 = abs(tem1) alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi @@ -741,7 +741,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l - if (abs(dtvd(2,1)) > 1.0e-10_r8) then + if (abs(dtvd(2,1)) > 1.0e-10_kp) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers @@ -850,7 +850,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & FLXD(L) = zero enddo ! - TLA = -10.0_r8 + TLA = -10.0_kp ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection @@ -930,7 +930,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! ENDDO ! End of the NC loop! ! - RAINC(ipt) = rain * 0.001_r8 ! Output rain is in meters + RAINC(ipt) = rain * 0.001_kp ! Output rain is in meters ktop(ipt) = kp1 kbot(ipt) = 0 @@ -944,9 +944,9 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! clw(i) = max(clw(i), zero) ! cli(i) = max(cli(i), zero) - if (sgcs(l,ipt) < 0.93_r8 .and. abs(tcu(l)) > one_m10) then -! if (sgcs(l,ipt) < 0.90_r8 .and. tcu(l) .ne. zero) then -! if (sgcs(l,ipt) < 0.85_r8 .and. tcu(l) .ne. zero) then + if (sgcs(l,ipt) < 0.93_kp .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90_kp .and. tcu(l) .ne. zero) then +! if (sgcs(l,ipt) < 0.85_kp .and. tcu(l) .ne. zero) then kcnv(ipt) = 1 endif ! New test for convective clouds ! added in 08/21/96 @@ -972,18 +972,18 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) CNV_FICE(ipt,ll) = QICN(ipt,ll) & - & / max(1.0e-10_r8,QLCN(ipt,ll)+QICN(ipt,ll)) + & / max(1.0e-10_kp,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) QICN(ipt,ll) = qii(l) - CNV_FICE(ipt,ll) = qii(l)/max(1.0e-10_r8,qii(l)+qli(l)) + CNV_FICE(ipt,ll) = qii(l)/max(1.0e-10_kp,qii(l)+qli(l)) endif - cf_upi(ipt,ll) = max(zero,min(0.02_r8*log(one+ & - & 500.0_r8*ud_mf(ipt,ll)/dt), cfmax)) + cf_upi(ipt,ll) = max(zero,min(0.02_kp*log(one+ & + & 500.0_kp*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,ll),1.0e-12_r8)*prsl(ipt,ll)) + & (dt*max(cf_upi(ipt,ll),1.0e-12_kp)*prsl(ipt,ll)) endif if (ntr > 0) then @@ -1023,21 +1023,21 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) CNV_FICE(ipt,l) = QICN(ipt,l) & - & / max(1.0e-10_r8,QLCN(ipt,l)+QICN(ipt,l)) + & / max(1.0e-10_kp,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) QICN(ipt,l) = qii(l) - CNV_FICE(ipt,l) = qii(l)/max(1.0e-10_r8,qii(l)+qli(l)) + CNV_FICE(ipt,l) = qii(l)/max(1.0e-10_kp,qii(l)+qli(l)) endif !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02_r8*log(one+ & - & 500.0_r8*ud_mf(ipt,l)/dt), cfmax)) + cf_upi(ipt,l) = max(zero,min(0.02_kp*log(one+ & + & 500.0_kp*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & - & (dt*max(cf_upi(ipt,l),1.0e-12_r8)*prsl(ipt,l)) + & (dt*max(cf_upi(ipt,l),1.0e-12_kp)*prsl(ipt,l)) endif if (ntr > 0) then @@ -1140,33 +1140,33 @@ SUBROUTINE CLOUD( & ! IMPLICIT NONE ! - real (kind=kind_phys), parameter :: RHMAX=1.0_r8 & ! MAX RELATIVE HUMIDITY - &, QUAD_LAM=1.0_r8 & ! MASK FOR QUADRATIC LAMBDA - &, RHRAM=0.05_r8 & ! PBL RELATIVE HUMIDITY RAMP -! &, RHRAM=0.15_r8 !& ! PBL RELATIVE HUMIDITY RAMP - &, HCRITD=4000.0_r8 & ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0_r8 & ! Critical Moist Static Energy for Shallow clouds - &, pcrit_lcl=250.0_r8 & ! Critical pressure difference between boundary layer top + real (kind=kind_phys), parameter :: RHMAX=1.0_kp & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0_kp & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05_kp & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15_kp !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0_kp & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0_kp & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0_kp & ! Critical pressure difference between boundary layer top ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01_r8 !& ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005_r8 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.01_kp !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005_kp !& ! Perturbation on hbl when ctei=.true. &, qudfac=quad_lam*half & - &, shalfac=3.0_r8 & -! &, qudfac=quad_lam*pt25, shalfac=3.0_r8 !& ! Yogesh's - &, c0ifac=0.07_r8 & ! following Han et al, 2016 MWR - &, dpnegcr = 150.0_r8 -! &, dpnegcr = 100.0_r8 -! &, dpnegcr = 200.0_r8 -! - real(kind=kind_phys), parameter :: ERRMIN=0.0001_r8 & - &, ERRMI2=0.1_r8*ERRMIN & -! &, rainmin=1.0e-9_r8 !& - &, rainmin=1.0e-8_r8 & - &, oneopt9=one/0.09_r8 & - &, oneopt4=one/0.04_r8 - real(kind=kind_phys), parameter :: almax=1.0e-2_r8 & - &, almin1=0.0_r8, almin2=0.0_r8 - real(kind=kind_phys), parameter :: bldmax=300.0_r8, bldmin=25.0_r8 + &, shalfac=3.0_kp & +! &, qudfac=quad_lam*pt25, shalfac=3.0_kp !& ! Yogesh's + &, c0ifac=0.07_kp & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0_kp +! &, dpnegcr = 100.0_kp +! &, dpnegcr = 200.0_kp +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001_kp & + &, ERRMI2=0.1_kp*ERRMIN & +! &, rainmin=1.0e-9_kp !& + &, rainmin=1.0e-8_kp & + &, oneopt9=one/0.09_kp & + &, oneopt4=one/0.04_kp + real(kind=kind_phys), parameter :: almax=1.0e-2_kp & + &, almin1=0.0_kp, almin2=0.0_kp + real(kind=kind_phys), parameter :: bldmax=300.0_kp, bldmin=25.0_kp ! ! INPUT ARGUMENTS @@ -1371,13 +1371,13 @@ SUBROUTINE CLOUD( & ! To determine KBL internally -- If KBL is defined externally ! the following two loop should be skipped ! - if (sgcs(kd) < 0.5_r8) then + if (sgcs(kd) < 0.5_kp) then hcrit = hcritd - elseif (sgcs(kd) > 0.65_r8) then + elseif (sgcs(kd) > 0.65_kp) then hcrit = hcrits else - hcrit = (hcrits*(sgcs(kd)-0.5_r8) + hcritd*(0.65_r8-sgcs(kd)))& - & * (one/0.15_r8) + hcrit = (hcrits*(sgcs(kd)-0.5_kp) + hcritd*(0.65_kp-sgcs(kd)))& + & * (one/0.15_kp) endif IF (CALKBL) THEN KTEM = MAX(KD+1, KBLMX) @@ -1461,7 +1461,7 @@ SUBROUTINE CLOUD( & ii = max(kbl,kd1) kbl = max(klcl,kd1) - tem = min(50.0_r8,max(10.0_r8,(prl(kmaxp1)-prl(kd))*0.10_r8)) + tem = min(50.0_kp,max(10.0_kp,(prl(kmaxp1)-prl(kd))*0.10_kp)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii @@ -1521,7 +1521,7 @@ SUBROUTINE CLOUD( & ! shal_fac = one ! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac - if (prl(kbl)-prl(kd) < 350.0_r8 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0_kp .and. kmax == k) shal_fac = shalfac DO L=Kmax,KD,-1 IF (L >= KBL) THEN ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM @@ -1583,7 +1583,7 @@ SUBROUTINE CLOUD( & endif enddo ! - if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0_r8) & + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0_kp) & & return ! TX1 = RHFACS - QBL / TX1 ! Average RH @@ -1593,9 +1593,9 @@ SUBROUTINE CLOUD( & IF (.NOT. cnvflg) RETURN ! - RHC = MAX(ZERO, MIN(ONE, EXP(-20.0_r8*TX1) )) + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0_kp*TX1) )) ! - wcbase = 0.1_r8 + wcbase = 0.1_kp if (ntrc > 0) then DO N=1,NTRC RBL(N) = ROI(Kmax,N) * ETA(Kmax) @@ -1752,13 +1752,13 @@ SUBROUTINE CLOUD( & HSU = HSU - ALM * TX3 ! CLP = ZERO - ALM = -100.0_r8 + ALM = -100.0_kp HOS = HOL(KD) QOS = QOL(KD) QIS = CIL(KD) QLS = CLL(KD) - cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4_r8 + cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4_kp !*********************************************************************** @@ -1775,7 +1775,7 @@ SUBROUTINE CLOUD( & if (tx2 == zero) then alm = - st2 / tx1 - if (alm > almax) alm = -100.0_r8 + if (alm > almax) alm = -100.0_kp else x00 = tx2 + tx2 epp = tx1 * tx1 - (x00+x00)*st2 @@ -1784,8 +1784,8 @@ SUBROUTINE CLOUD( & tem = sqrt(epp) tem1 = (-tx1-tem)*x00 tem2 = (-tx1+tem)*x00 - if (tem1 > almax) tem1 = -100.0_r8 - if (tem2 > almax) tem2 = -100.0_r8 + if (tem1 > almax) tem1 = -100.0_kp + if (tem2 > almax) tem2 = -100.0_kp alm = max(tem1,tem2) endif @@ -1856,12 +1856,12 @@ SUBROUTINE CLOUD( & ACR = zero TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF tx1 = PRL(KBL) - TEM - tx2 = min(900.0_r8, max(tx1,100.0_r8)) - tem1 = log(tx2*0.01_r8) * oneolog10 + tx2 = min(900.0_kp, max(tx1,100.0_kp)) + tem1 = log(tx2*0.01_kp) * oneolog10 tem2 = one - tem1 if ( kdt == 1 ) then -! rel_fac = (dt * facdt) / (tem1*12.0_r8 + tem2*3.0) - rel_fac = (dt * facdt) / (tem1*6.0_r8 + tem2*adjts_s) +! rel_fac = (dt * facdt) / (tem1*12.0_kp + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0_kp + tem2*adjts_s) else rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) endif @@ -1870,7 +1870,7 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - iwk = tem*0.02_r8 - 0.999999999_r8 + iwk = tem*0.02_kp - 0.999999999_kp iwk = MAX(1, MIN(iwk, 16)) ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF ENDIF @@ -2043,7 +2043,7 @@ SUBROUTINE CLOUD( & ! CALCUP = .FALSE. - TEM = max(0.05_r8, MIN(CD*200.0_r8, MAX_NEG_BOUY)) + TEM = max(0.05_kp, MIN(CD*200.0_kp, MAX_NEG_BOUY)) IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. @@ -2086,7 +2086,7 @@ SUBROUTINE CLOUD( & ENDIF PL = (PRL(KD1) + PRL(KD))*HALF - IF (TRAIN > 1.0e-4_r8 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + IF (TRAIN > 1.0e-4_kp .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) @@ -2401,7 +2401,7 @@ SUBROUTINE CLOUD( & ! sigf(kd) = max(zero, min(one, tx1 * tx1)) ! endif if (do_aw) then - tx1 = (0.2_r8 / max(alm, 1.0e-5_r8)) + tx1 = (0.2_kp / max(alm, 1.0e-5_kp)) tx2 = one - min(one, pi * tx1 * tx1 / area) tx2 = tx2 * tx2 @@ -2525,8 +2525,8 @@ SUBROUTINE CLOUD( & endif enddo tem = tem + amb * dof * sigf(kbl) - tem = tem * (3600.0_r8/dt) - tem1 = sqrt(max(one, min(100.0_r8,(6.25e10_r8/max(area,one))))) ! 20110530 + tem = tem * (3600.0_kp/dt) + tem1 = sqrt(max(one, min(100.0_kp,(6.25e10_kp/max(area,one))))) ! 20110530 clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) cldfrd = clfrac @@ -2573,7 +2573,7 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778_r8 )) + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778_kp )) ACTEVAP = MIN(TX1, TEM4*CLFRAC) @@ -2581,7 +2581,7 @@ SUBROUTINE CLOUD( & ! tem4 = zero if (tx2 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778_r8 )) + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778_kp )) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2650,7 +2650,7 @@ SUBROUTINE CLOUD( & ! following Liu et al. [JGR,2001] Eq 1 if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001_r8) + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001_kp) FNOSCAV = exp(- FSCAV_(N) * DELZKM) else FNOSCAV = one @@ -2660,7 +2660,7 @@ SUBROUTINE CLOUD( & & * FNOSCAV DO L=KD1,K if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001_r8) + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001_kp) FNOSCAV = exp(- FSCAV_(N) * DELZKM) endif lm1 = l - 1 @@ -2779,7 +2779,7 @@ SUBROUTINE DDRFT( & &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & &, IDW, IDH, IDN(K), idnm, itr ! - parameter (ERRMIN=0.0001_r8, ERRMI2=0.1_r8*ERRMIN) + parameter (ERRMIN=0.0001_kp, ERRMI2=0.1_kp*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! ! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi @@ -2789,9 +2789,9 @@ SUBROUTINE DDRFT( & ! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) ! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) ! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) - PARAMETER (AA1=1.0_r8, BB1=1.0_r8, CC1=1.0_r8, DD1=1.0_r8, & - & F3=CC1, F5=1.0_r8) - parameter (QRMIN=1.0e-6_r8, WC2MIN=0.01_r8, GMF1=GMF/AA1, GMF5=GMF/F5) + PARAMETER (AA1=1.0_kp, BB1=1.0_kp, CC1=1.0_kp, DD1=1.0_kp, & + & F3=CC1, F5=1.0_kp) + parameter (QRMIN=1.0e-6_kp, WC2MIN=0.01_kp, GMF1=GMF/AA1, GMF5=GMF/F5) ! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) @@ -2800,12 +2800,12 @@ SUBROUTINE DDRFT( & &, itrmin=15, itrmnd=12, numtla=2 ! uncentering for vvel in dd - real(kind=kind_phys), parameter :: ddunc1=0.25_r8 & + real(kind=kind_phys), parameter :: ddunc1=0.25_kp & &, ddunc2=one-ddunc1 & ! &, ddunc1=0.4, ddunc2=one-ddunc1 & ! &, ddunc1=0.3, ddunc2=one-ddunc1 & - &, VTPEXP=-0.3636_r8 & - &, VTP=36.34_r8*SQRT(1.2_r8)*(0.001_r8)**0.1364_r8 + &, VTPEXP=-0.3636_kp & + &, VTP=36.34_kp*SQRT(1.2_kp)*(0.001_kp)**0.1364_kp ! ! real(kind=kind_phys) EM(K*K), ELM(K) real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & @@ -2830,7 +2830,7 @@ SUBROUTINE DDRFT( & CLDFRD = zero RNTP = zero DOF = zero - ERRQ = 10.0_r8 + ERRQ = 10.0_kp RNB = zero RNT = zero TX2 = PRL(KBL) @@ -2861,7 +2861,7 @@ SUBROUTINE DDRFT( & ENDDO if (kk /= kbl) then do l=kk,kbl - buy(l) = 0.9_r8 * buy(l-1) + buy(l) = 0.9_kp * buy(l-1) enddo endif ! @@ -2869,24 +2869,24 @@ SUBROUTINE DDRFT( & qrpi(l) = buy(l) enddo do l=kd1,kb1 - buy(l) = 0.25_r8 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + buy(l) = 0.25_kp * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) enddo ! ! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) - tx1 = 1000.0_r8 + tx1 - prl(kp1) + tx1 = 1000.0_kp + tx1 - prl(kp1) ! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) CALL ANGRAD(TX1, ALM, AL2, TLA) ! ! Following Ucla approach for rain profile ! - F2 = (BB1+BB1)*ONEBG/(PI*0.2_r8) + F2 = (BB1+BB1)*ONEBG/(PI*0.2_kp) ! WCMIN = SQRT(WC2MIN) ! WCBASE = WCMIN ! ! del_tla = TLA * 0.2 ! del_tla = TLA * 0.25 - del_tla = TLA * 0.3_r8 + del_tla = TLA * 0.3_kp TLA = TLA - DEL_TLA ! DO L=KD,K @@ -2947,7 +2947,7 @@ SUBROUTINE DDRFT( & do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries ! ------ ! if (errq < 1.0 .or. tla > 45.0) cycle - if (errq < 0.1_r8 .or. tla > 45.0_r8) cycle + if (errq < 0.1_kp .or. tla > 45.0_kp) cycle ! tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle @@ -2955,7 +2955,7 @@ SUBROUTINE DDRFT( & ! STLA = F2 * STLA * AL2 CTL2 = DD1 * CTL2 - CTL3 = 0.1364_r8 * CTL2 + CTL3 = 0.1364_kp * CTL2 ! DO L=KD,K RNF(L) = zero @@ -3018,7 +3018,7 @@ SUBROUTINE DDRFT( & VRW(1) = F3*WVL(KD) - CTL2*VT(1) BUD(KD) = STLA * TX6 * QRB(KD) * half RNF(KD) = BUD(KD) - DOF = 1.1364_r8 * BUD(KD) * QRPI(KD) + DOF = 1.1364_kp * BUD(KD) * QRPI(KD) DOFW = -BUD(KD) * STLT(KD) ! RNT = TRW(1) * VRW(1) @@ -3052,7 +3052,7 @@ SUBROUTINE DDRFT( & ! QA(2) = DOF WA(2) = DOFW - DOF = 1.1364_r8 * BUD(L) * QRPI(L) + DOF = 1.1364_kp * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + QQQ * ST1 @@ -3123,7 +3123,7 @@ SUBROUTINE DDRFT( & QA(2) = DOF WA(2) = DOFW - DOF = 1.1364_r8 * BUD(L) * QRPI(L) + DOF = 1.1364_kp * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + ST1 @@ -3258,7 +3258,7 @@ SUBROUTINE DDRFT( & ENDDO ! ! tem = 0.5 - if (tx2 > one .and. abs(errq-tx2) > 0.1_r8) then + if (tx2 > one .and. abs(errq-tx2) > 0.1_kp) then tem = half !! elseif (tx2 < 0.1) then !! tem = 1.2 @@ -3281,17 +3281,17 @@ SUBROUTINE DDRFT( & ENDIF ELSE TEM = ERRQ - TX2 -! IF (TEM < ZERO .AND. ERRQ > 0.1_r8) THEN - IF (TEM < ZERO .AND. ERRQ > 0.5_r8) THEN +! IF (TEM < ZERO .AND. ERRQ > 0.1_kp) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5_kp) THEN ! IF (TEM < ZERO .and. & -! & (ntla < numtla .or. ERRQ > 0.5_r8)) THEN +! & (ntla < numtla .or. ERRQ > 0.5_kp)) THEN SKPUP = .TRUE. ! No convergence ! - ERRQ = 10.0_r8 ! No rain profile! + ERRQ = 10.0_kp ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! - elseif (tem < zero .and. errq < 0.1_r8) then + elseif (tem < zero .and. errq < 0.1_kp) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then errq = zero @@ -3309,7 +3309,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the ITR Loop!! ! - IF (ERRQ < 0.1_r8) THEN + IF (ERRQ < 0.1_kp) THEN DDFT = .TRUE. RNB = - RNB ! do l=kd1,kb1-1 @@ -3330,7 +3330,7 @@ SUBROUTINE DDRFT( & TX1 = TX1 + RNF(L) ENDDO TX1 = TRAIN / (TX1+RNT+RNB) - IF (ABS(TX1-one) < 0.2_r8) THEN + IF (ABS(TX1-one) < 0.2_kp) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 DO L=KD,KB1 @@ -3340,7 +3340,7 @@ SUBROUTINE DDRFT( & ELSE DDFT = .FALSE. - ERRQ = 10.0_r8 + ERRQ = 10.0_kp ENDIF ENDIF ! @@ -3364,7 +3364,7 @@ SUBROUTINE DDRFT( & WCB(L) = zero ENDDO ! - ERRQ = 10.0_r8 + ERRQ = 10.0_kp ! At this point stlt contains inverse of updraft vertical velocity 1/Wu. KK = MAX(KB1,KD1) @@ -3410,9 +3410,9 @@ SUBROUTINE DDRFT( & IF (RNT > zero) THEN if (TX1 > zero) THEN QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & - & ** (one/1.1364_r8) + & ** (one/1.1364_kp) else - tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364_r8) + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364_kp) endif RNTP = (one - RPART) * RNT BUY(KD) = - ROR(KD) * TX1 * QRP(KD) @@ -3473,7 +3473,7 @@ SUBROUTINE DDRFT( & VRW(1) = half * (GAM(L-1) + GAM(L)) VRW(2) = one / (VRW(1) + VRW(1)) ! - TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0_r8*EKNOB) + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0_kp*EKNOB) ! DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! ! @@ -3481,7 +3481,7 @@ SUBROUTINE DDRFT( & HOD(L) = HOD(L-1) QOD(L) = QOD(L-1) ! - ERRQ = 10.0_r8 + ERRQ = 10.0_kp ! IF (L <= KBL) THEN @@ -3506,7 +3506,7 @@ SUBROUTINE DDRFT( & IF (L == KD1) THEN IF (RNT > zero) THEN TEM = MAX(QRP(L-1),QRP(L)) - WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0_r8) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0_kp) ENDIF WVL(L) = MAX(ONE_M2, WVL(L)) TRW(1) = TRW(1) * half @@ -3634,9 +3634,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6_r8 + 124.9_r8 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6_kp + 124.9_kp * QRAF) * QRBF * TX4 ! - CE = TEM6 * ST2 / ((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4e5_kp*ST2 + 2.55e6_kp)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) @@ -3647,7 +3647,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6 * ST2 / ((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4e5_kp*ST2 + 2.55e6_kp)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3668,7 +3668,7 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(TEM,ZERO) ELSEIF (TX5 > zero) THEN QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & - & ** (one/1.1364_r8) + & ** (one/1.1364_kp) ELSE QRP(L) = zero ENDIF @@ -3695,7 +3695,7 @@ SUBROUTINE DDRFT( & ! WVL(L) = 0.5*tem1 ! WVL(L) = 0.1*tem1 ! WVL(L) = 0.0 - WVL(L) = 1.0e-10_r8 + WVL(L) = 1.0e-10_kp else WVL(L) = half*(WVL(L)+TEM1) endif @@ -3709,7 +3709,7 @@ SUBROUTINE DDRFT( & ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.2_r8) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2_kp) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3721,7 +3721,7 @@ SUBROUTINE DDRFT( & TX5 = TX9 else TX5 = (STLT(KB1) * QRT(KB1) & - & + STLT(KBL) * QRB(KB1)) * (0.5_r8*FAC) + & + STLT(KBL) * QRB(KB1)) * (0.5_kp*FAC) endif EVP(L-1) = zero @@ -3730,14 +3730,14 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364_r8) + & ** (one/1.1364_kp) ! endif BUY(L) = - ROR(L) * TX5 * QRP(L) WCB(L-1) = zero ENDIF ! DEL_ETA = ETD(L) - ETD(L-1) - IF(DEL_ETA < zero .AND. ERRQ > 0.1_r8) THEN + IF(DEL_ETA < zero .AND. ERRQ > 0.1_kp) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3764,9 +3764,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L-1) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6_r8 + 124.9_r8 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6_kp + 124.9_kp * QRAF) * QRBF * TX4 ! - CE = TEM6*ST2/((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4e5_kp*ST2 + 2.55e6_kp)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) @@ -3777,7 +3777,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6*ST2/((5.4e5_r8*ST2 + 2.55e6_r8)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4e5_kp*ST2 + 2.55e6_kp)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -3830,7 +3830,7 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the iteration loop for a given L! IF (L <= K) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.1_r8 .and. l <= kbl) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1_kp .and. l <= kbl) THEN !!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN ! & .AND. ERRQ > ERRMIN*10.0) THEN ROR(L) = BUD(KD) @@ -3853,7 +3853,7 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364_r8) + & ** (one/1.1364_kp) ! ENDIF ETD(L) = zero WVL(L) = zero @@ -3884,7 +3884,7 @@ SUBROUTINE DDRFT( & ! not converge) , no downdraft is assumed ! ! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & - IF (ERRQ > 0.1_r8 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. + IF (ERRQ > 0.1_kp .AND. IDN(idnm) == idnmax) DDFT = .FALSE. ! DOF = zero IF (.NOT. DDFT) RETURN @@ -3988,7 +3988,7 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys) es, d, hlorv, W ! ! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = min(p, 0.01_r8 * fpvs(tt)) ! fpvs is in Pascals! + es = min(p, 0.01_kp * fpvs(tt)) ! fpvs is in Pascals! ! D = one / max(p+epsm1*es,ONE_M10) D = one / (p+epsm1*es) ! @@ -4009,7 +4009,7 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) ! integer i ! - IF (TLA < 0.0_r8) THEN + IF (TLA < 0.0_kp) THEN IF (PRES <= PLAC(1)) THEN TLA = TLAC(1) ELSEIF (PRES <= PLAC(2)) THEN @@ -4046,8 +4046,8 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) TEM = REFR(6) ENDIF ! - tem = 2.0e-4_r8 / tem - al2 = min(4.0_r8*tem, max(alm, tem)) + tem = 2.0e-4_kp / tem + al2 = min(4.0_kp*tem, max(alm, tem)) ! RETURN end subroutine angrad @@ -4059,18 +4059,18 @@ SUBROUTINE SETQRP integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! XMIN = 1.0E-6 - XMIN = 0.0_r8 - XMAX = 5.0_r8 + XMIN = 0.0_kp + XMAX = 5.0_kp XINC = (XMAX-XMIN)/(NQRP-1) C2XQRP = one / XINC C1XQRP = one - XMIN*C2XQRP - TEM1 = 0.001_r8 ** 0.2046_r8 - TEM2 = 0.001_r8 ** 0.525_r8 + TEM1 = 0.001_kp ** 0.2046_kp + TEM2 = 0.001_kp ** 0.525_kp DO JX=1,NQRP X = XMIN + (JX-1)*XINC - TBQRP(JX) = X ** 0.1364_r8 - TBQRA(JX) = TEM1 * X ** 0.2046_r8 - TBQRB(JX) = TEM2 * X ** 0.525_r8 + TBQRP(JX) = X ** 0.1364_kp + TBQRA(JX) = TEM1 * X ** 0.2046_kp + TBQRB(JX) = TEM2 * X ** 0.525_kp ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN @@ -4095,12 +4095,12 @@ end subroutine qrabf SUBROUTINE SETVTP implicit none - real(kind=kind_phys), parameter :: vtpexp=-0.3636_r8, one=1.0_r8 + real(kind=kind_phys), parameter :: vtpexp=-0.3636_kp, one=1.0_kp real(kind=kind_phys) xinc,x,xmax,xmin integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - XMIN = 0.05_r8 - XMAX = 1.5_r8 + XMIN = 0.05_kp + XMAX = 1.5_kp XINC = (XMAX-XMIN)/(NVTP-1) C2XVTP = one / XINC C1XVTP = one - XMIN*C2XVTP @@ -4147,10 +4147,10 @@ real(kind=kind_phys) FUNCTION CLF(PRATE) implicit none real(kind=kind_phys) PRATE ! - real (kind=kind_phys), parameter :: ccf1=0.30_r8, ccf2=0.09_r8 & - &, ccf3=0.04_r8, ccf4=0.01_r8 & - &, pr1=1.0_r8, pr2=5.0_r8 & - &, pr3=20.0_r8 + real (kind=kind_phys), parameter :: ccf1=0.30_kp, ccf2=0.09_kp & + &, ccf3=0.04_kp, ccf4=0.01_kp & + &, pr1=1.0_kp, pr2=5.0_kp & + &, pr3=20.0_kp ! if (prate < pr1) then clf = ccf1 diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index f84da9bec..b7ef1ea68 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -86,7 +86,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! implicit none ! - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys integer, intent(in) :: im, ivegsrc integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean @@ -131,11 +131,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys) :: tvs, z0, z0max, ztmax ! real(kind=kind_phys), parameter :: - & one=1.0_r8, zero=0.0_r8, half=0.5_r8, qmin=1.0e-8_r8 - &, charnock=.014_r8, z0s_max=.317e-2_r8 &! a limiting value at high winds over sea - &, zmin=1.0e-6_r8 & - &, vis=1.4e-5_r8, rnu=1.51e-5_r8, visi=one/vis & - &, log01=log(0.01_r8), log05=log(0.05_r8), log07=log(0.07_r8) + & one=1.0_kp, zero=0.0_kp, half=0.5_kp, qmin=1.0e-8_kp + &, charnock=.014_kp, z0s_max=.317e-2_kp &! a limiting value at high winds over sea + &, zmin=1.0e-6_kp & + &, vis=1.4e-5_kp, rnu=1.51e-5_kp, visi=one/vis & + &, log01=log(0.01_kp), log05=log(0.05_kp), log07=log(0.07_kp) ! parameter (charnock=.014,ca=.4)!c ca is the von karman constant ! parameter (alpha=5.,a0=-3.975,a1=12.32,b1=-7.755,b2=6.041) @@ -179,7 +179,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) #else tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac #endif - z0max = max(zmin, min(0.01_r8 * z0rl_lnd(i), z1(i))) + z0max = max(zmin, min(0.01_kp * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land tem1 = one - shdmax(i) tem2 = tem1 * tem1 @@ -193,10 +193,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 7) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01_r8 + z0max = 0.01_kp elseif (vegtype(i) == 16) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01_r8 + z0max = 0.01_kp else z0max = exp( tem2*log01 + tem1*log(z0max) ) endif @@ -209,10 +209,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 9) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01_r8 + z0max = 0.01_kp elseif (vegtype(i) == 11) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01_r8 + z0max = 0.01_kp else z0max = exp( tem2*log01 + tem1*log(z0max) ) endif @@ -220,22 +220,22 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif ! mg, sfc-perts: add surface perturbations to z0max over land if (z0pert(i) /= zero ) then - z0max = z0max * (10.0_r8**z0pert(i)) + z0max = z0max * (10.0_kp**z0pert(i)) endif z0max = max(z0max, zmin) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil - czilc = 0.8_r8 + czilc = 0.8_kp - tem1 = 1.0_r8 - sigmaf(i) + tem1 = 1.0_kp - sigmaf(i) ztmax = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land if (ztpert(i) /= zero) then - ztmax = ztmax * (10.0_r8**ztpert(i)) + ztmax = ztmax * (10.0_kp**ztpert(i)) endif ztmax = max(ztmax, zmin) ! @@ -250,7 +250,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) if (icy(i)) then ! Some ice tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac - z0max = max(zmin, min(0.01_r8 * z0rl_ice(i), z1(i))) + z0max = max(zmin, min(0.01_kp * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice tem1 = one - shdmax(i) tem2 = tem1 * tem1 @@ -267,9 +267,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height ! dependance of czil - czilc = 0.8_r8 + czilc = 0.8_kp - tem1 = 1.0_r8 - sigmaf(i) + tem1 = 1.0_kp - sigmaf(i) ztmax = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ztmax = max(ztmax, 1.0e-6) @@ -288,7 +288,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) if (wet(i)) then ! Some open ocean tvs = half * (tsurf_wat(i)+tskin_wat(i)) * virtfac - z0 = 0.01_r8 * z0rl_wat(i) + z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ustar_wat(i) = sqrt(grav * z0 / charnock) wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) @@ -297,7 +297,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ztmax = z0max - restar = max(ustar_wat(i)*z0max*visi, 0.000001_r8) + restar = max(ustar_wat(i)*z0max*visi, 0.000001_kp) ! restar = log(restar) ! restar = min(restar,5.) @@ -306,7 +306,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! rat = rat / (1. + (bb2 + cc2*restar) * restar)) ! rat taken from zeng, zhao and dickinson 1997 - rat = min(7.0_r8, 2.67_r8 * sqrt(sqrt(restar)) - 2.57_r8) + rat = min(7.0_kp, 2.67_kp * sqrt(sqrt(restar)) - 2.57_kp) ztmax = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then @@ -341,29 +341,29 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! z0 = arnu / (ustar(i) * ff ** pp) if (redrag) then - z0rl_wat(i) = 100.0_r8 * max(min(z0, z0s_max), & - & 1.0e-7_r8) + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max), & + & 1.0e-7_kp) else - z0rl_wat(i) = 100.0_r8 * max(min(z0,0.1_r8), 1.e-7_r8) + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.e-7_kp) endif elseif (sfc_z0_type == 6) then ! wang call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_wat(i) = 100.0_r8 * z0 ! cm + z0rl_wat(i) = 100.0_kp * z0 ! cm elseif (sfc_z0_type == 7) then ! wang call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_wat(i) = 100.0_r8 * z0 ! cm + z0rl_wat(i) = 100.0_kp * z0 ! cm else - z0rl_wat(i) = 1.0e-4_r8 + z0rl_wat(i) = 1.0e-4_kp endif - elseif (z0rl_wav(i) <= 1.0e-7_r8) then + elseif (z0rl_wav(i) <= 1.0e-7_kp) then z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) if (redrag) then - z0rl_wat(i) = 100.0_r8 * max(min(z0, z0s_max),1.0e-7_r8) + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) else - z0rl_wat(i) = 100.0_r8 * max(min(z0,0.1_r8), 1.0e-7_r8) + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) endif endif @@ -385,7 +385,7 @@ subroutine stability & & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) !----- - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys ! --- inputs: real(kind=kind_phys), intent(in) :: & & z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav @@ -395,12 +395,12 @@ subroutine stability & & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar ! --- locals: - real(kind=kind_phys), parameter :: alpha=5.0_r8, a0=-3.975_r8 & - &, a1=12.32_r8, alpha4=4.0_r8*alpha & - &, b1=-7.755_r8, b2=6.041, alpha2=alpha+alpha & - &, beta=1.0_r8 & - &, a0p=-7.941_r8, a1p=24.75_r8, b1p=-8.705_r8, b2p=7.899_r8& - &, ztmin1=-999.0_r8, zero=0.0_r8, one=1.0_r8 + real(kind=kind_phys), parameter :: alpha=5.0_kp, a0=-3.975_kp & + &, a1=12.32_kp, alpha4=4.0_kp*alpha & + &, b1=-7.755_kp, b2=6.041_kp, alpha2=alpha+alpha & + &, beta=1.0_kp & + &, a0p=-7.941_kp, a1p=24.75_kp, b1p=-8.705_kp, b2p=7.899_kp& + &, ztmin1=-999.0_kp, zero=0.0_kp, one=1.0_kp real(kind=kind_phys) aa, aa0, bb, bb0, dtv, adtv, & hl1, hl12, pm, ph, pm10, ph2, @@ -412,31 +412,31 @@ subroutine stability & z1i = one / z1 tem1 = z0max/z1 - if (abs(one-tem1) > 1.0e-6_r8) then + if (abs(one-tem1) > 1.0e-6_kp) then ztmax1 = - beta*log(tem1)/(alpha2*(one-tem1)) else - ztmax1 = 99.0_r8 + ztmax1 = 99.0_kp endif - if( z0max < 0.05_r8 .and. snwdph < 10.0_r8 ) ztmax1 = 99.0_r8 + if( z0max < 0.05_kp .and. snwdph < 10.0_kp ) ztmax1 = 99.0_kp ! compute stability indices (rb and hlinf) dtv = thv1 - tvs - adtv = max(abs(dtv),0.001_r8) + adtv = max(abs(dtv),0.001_kp) dtv = sign(1.,dtv) * adtv #ifdef GSD_SURFACE_FLUXES_BUGFIX - rb = max(-5000.0_r8, grav * dtv * z1 + rb = max(-5000.0_kp, grav * dtv * z1 & / (thv1 * wind * wind)) #else - rb = max(-5000.0_r8, (grav+grav) * dtv * z1 + rb = max(-5000.0_kp, (grav+grav) * dtv * z1 & / ((thv1 + tvs) * wind * wind)) #endif tem1 = one / z0max tem2 = one / ztmax fm = log((z0max+z1) * tem1) fh = log((ztmax+z1) * tem2) - fm10 = log((z0max+10.0_r8) * tem1) - fh2 = log((ztmax+2.0_r8) * tem2) + fm10 = log((z0max+10.0_kp) * tem1) + fh2 = log((ztmax+2.0_kp) * tem2) hlinf = rb * fm * fm / fh hlinf = min(max(hlinf,ztmin1),ztmax1) ! @@ -444,7 +444,7 @@ subroutine stability & ! if (dtv >= zero) then hl1 = hlinf - if(hlinf > 0.25_r8) then + if(hlinf > 0.25_kp) then tem1 = hlinf * z1i hl0inf = z0max * tem1 hltinf = ztmax * tem1 @@ -471,7 +471,7 @@ subroutine stability & bb0 = sqrt(one + alpha4 * hlt) pm = aa0 - aa + log( (one+aa)/(one+aa0) ) ph = bb0 - bb + log( (one+bb)/(one+bb0) ) - hl110 = hl1 * 10.0_r8 * z1i + hl110 = hl1 * 10.0_kp * z1i hl110 = min(max(hl110, ztmin1), ztmax1) aa = sqrt(one + alpha4 * hl110) pm10 = aa0 - aa + log( (one+aa)/(one+aa0) ) @@ -485,7 +485,7 @@ subroutine stability & ! else ! dtv < 0 case olinf = z1 / hlinf - tem1 = 50.0_r8 * z0max + tem1 = 50.0_kp * z0max if(abs(olinf) <= tem1) then hlinf = -z1 / tem1 hlinf = min(max(hlinf,ztmin1),ztmax1) @@ -493,11 +493,11 @@ subroutine stability & ! ! get pm and ph ! - if (hlinf >= -0.5_r8) then + if (hlinf >= -0.5_kp) then hl1 = hlinf pm = (a0 + a1*hl1) * hl1 / (one+ (b1+b2*hl1) *hl1) ph = (a0p + a1p*hl1) * hl1 / (one+ (b1p+b2p*hl1)*hl1) - hl110 = hl1 * 10.0_r8 * z1i + hl110 = hl1 * 10.0_kp * z1i hl110 = min(max(hl110, ztmin1), ztmax1) pm10 = (a0 + a1*hl110) * hl110/(one+(b1+b2*hl110)*hl110) hl12 = (hl1+hl1) * z1i @@ -506,17 +506,17 @@ subroutine stability & else ! hlinf < 0.05 hl1 = -hlinf tem1 = one / sqrt(hl1) - pm = log(hl1) + 2.0_r8 * sqrt(tem1) - .8776_r8 - ph = log(hl1) + 0.5_r8 * tem1 + 1.386_r8 + pm = log(hl1) + 2.0_kp * sqrt(tem1) - .8776_kp + ph = log(hl1) + 0.5_kp * tem1 + 1.386_kp ! pm = log(hl1) + 2.0 * hl1 ** (-.25) - .8776 ! ph = log(hl1) + 0.5 * hl1 ** (-.5) + 1.386 - hl110 = hl1 * 10.0_r8 * z1i + hl110 = hl1 * 10.0_kp * z1i hl110 = min(max(hl110, ztmin1), ztmax1) - pm10 = log(hl110) + 2.0_r8/sqrt(sqrt(hl110)) - 0.8776_r8 + pm10 = log(hl110) + 2.0_kp/sqrt(sqrt(hl110)) - 0.8776_kp ! pm10 = log(hl110) + 2. * hl110 ** (-.25) - .8776 hl12 = (hl1+hl1) * z1i hl12 = min(max(hl12, ztmin1), ztmax1) - ph2 = log(hl12) + 0.5_r8 / sqrt(hl12) + 1.386_r8 + ph2 = log(hl12) + 0.5_kp / sqrt(hl12) + 1.386_kp ! ph2 = log(hl12) + .5 * hl12 ** (-.5) + 1.386 endif @@ -530,7 +530,7 @@ subroutine stability & fh2 = fh2 - ph2 cm = ca * ca / (fm * fm) ch = ca * ca / (fm * fh) - tem1 = 0.00001_r8/z1 + tem1 = 0.00001_kp/z1 cm = max(cm, tem1) ch = max(ch, tem1) stress = cm * wind * wind diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index cfe191a85..5920f375c 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -176,13 +176,13 @@ subroutine sfc_nst_run & ! implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys ! ! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0_r8 ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0_r8 ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001_r8 ! cos(89.994) - real (kind=kind_phys), parameter :: zero = 0.0_r8, one = 1.0_r8 + real (kind=kind_phys), parameter :: f24 = 24.0_kp ! hours/day + real (kind=kind_phys), parameter :: f1440 = 1440.0_kp ! minutes/day + real (kind=kind_phys), parameter :: czmin = 0.0001_kp ! cos(89.994) + real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp ! --- inputs: @@ -256,7 +256,7 @@ subroutine sfc_nst_run & hvapi = one/hvap elocp = hvap/cp - sss = 34.0_r8 ! temporarily, when sea surface salinity data is not ready + sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready ! ! flag for open water and where the iteration is on ! @@ -297,7 +297,7 @@ subroutine sfc_nst_run & nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - q0(i) = max(q1(i), 1.0e-8_r8) + q0(i) = max(q1(i), 1.0e-8_kp) #ifdef GSD_SURFACE_FLUXES_BUGFIX theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer #else @@ -337,8 +337,8 @@ subroutine sfc_nst_run & ! run nst model: dtm + slm ! - zsea1 = 0.001_r8*real(nstf_name4) - zsea2 = 0.001_r8*real(nstf_name5) + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) !> - Call module_nst_water_prop::density() to compute sea water density. !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion @@ -350,20 +350,20 @@ subroutine sfc_nst_run & ulwflx(i) = sfcemis(i) * sbc * t12 * t12 alon = xlon(i)*rad2deg grav = grv(sinlat(i)) - soltim = mod(alon/15.0_r8 + solhr, 24.0_r8)*3600.0_r8 + soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp call density(tsea,sss,rho_w) ! sea water density call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta ! !> - Calculate sensible heat flux (\a qrain) due to rainfall. ! - le = (2.501_r8-0.00237_r8*tsea)*1e6_r8 - dwat = 2.11e-5_r8*(t1(i)/t0k)**1.94_r8 ! water vapor diffusivity - dtmp = (one+3.309e-3_r8*(t1(i)-t0k)-1.44e-6_r8*(t1(i)-t0k) - & * (t1(i)-t0k))*0.02411_r8/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0_r8*le*qss(i)/(rd*t1(i)*t1(i)) + le = (2.501_kp-0.00237_kp*tsea)*1e6_kp + dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity + dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) + & * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity + wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - tem = (1.0e3_r8 * rain(i) / rho_w) * alfac * cp_w - qrain(i) = tem * (tsea-t1(i)+1.0e3_r8*(qss(i)-q0(i))*le/cp) + tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w + qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) !> - Calculate input non solar heat flux as upward = positive to models here @@ -379,7 +379,7 @@ subroutine sfc_nst_run & ! ! sensitivities of heat flux components to ts ! - rnl_ts = 4.0_r8*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) + rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) hs_ts = rch(i) hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) rf_ts = tem * (one+rch(i)*hl_ts) @@ -543,7 +543,7 @@ subroutine sfc_nst_run & ! endif ! if ( xt(i) > 0.0 ) then ! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0_r8*timestep ) then + if ( abs(soltim) < 2.0_kp*timestep ) then call dtl_reset & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) endif @@ -556,7 +556,7 @@ subroutine sfc_nst_run & !> - Call get_dtzm_point() to computes \a dtz and \a tsurf. call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), & zsea1,zsea2,dtz) - tsurf(i) = max(271.2_r8, tref(i) + dtz ) + tsurf(i) = max(271.2_kp, tref(i) + dtz ) ! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', ! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) @@ -683,7 +683,7 @@ subroutine sfc_nst_pre_run implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys ! --- inputs: integer, intent(in) :: im, nthreads @@ -702,10 +702,10 @@ subroutine sfc_nst_pre_run ! --- locals integer :: i - real(kind=kind_phys), parameter :: zero = 0.0_r8, - & one = 1.0_r8, - & half = 0.5_r8, - & omz1 = 2.0_r8 + real(kind=kind_phys), parameter :: zero = 0.0_kp, + & one = 1.0_kp, + & half = 0.5_kp, + & omz1 = 2.0_kp real(kind=kind_phys) :: tem1, tem2, dnsst real(kind=kind_phys), dimension(im) :: dtzm @@ -794,7 +794,7 @@ subroutine sfc_nst_post_run & implicit none - integer, parameter :: r8 = kind_phys + integer, parameter :: kp = kind_phys ! --- inputs: integer, intent(in) :: im, nthreads @@ -837,8 +837,8 @@ subroutine sfc_nst_post_run & ! --- ... run nsst model ... --- if (nstf_name1 > 1) then - zsea1 = 0.001_r8*real(nstf_name4) - zsea2 = 0.001_r8*real(nstf_name5) + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & & im, 1, nthreads, dtzm) do i = 1, im diff --git a/physics/wv_saturation.F b/physics/wv_saturation.F index b19da7b5e..f3047b542 100644 --- a/physics/wv_saturation.F +++ b/physics/wv_saturation.F @@ -9,12 +9,12 @@ !! This module contain some utility functions for saturation vapor pressure. module wv_saturation #ifdef GEOS5 - use MAPL_ConstantsMod, r8 => MAPL_R8 + use MAPL_ConstantsMod, kp => MAPL_kp #endif #ifdef NEMS_GSM use funcphys, only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice #endif - use machine, only : r8 => kind_phys + use machine, only : kp => kind_phys !++jtb (comm out) @@ -61,37 +61,37 @@ module wv_saturation ! to tmax+1 degrees k in one degree increments. ttrice defines the ! transition region where es is a combination of ice & water values ! - real(r8) estbl(plenest) - real(r8) tmin - real(r8) tmax - real(r8) ttrice - real(r8) pcf(6) - real(r8) epsqs - real(r8) rgasv - real(r8) hlatf - real(r8) hlatv - real(r8) cp - real(r8) tmelt + real(kp) estbl(plenest) + real(kp) tmin + real(kp) tmax + real(kp) ttrice + real(kp) pcf(6) + real(kp) epsqs + real(kp) rgasv + real(kp) hlatf + real(kp) hlatv + real(kp) cp + real(kp) tmelt logical icephs integer, parameter :: iulog=6 contains - real(r8) function estblf( td ) + real(kp) function estblf( td ) ! ! Saturation vapor pressure table lookup ! - real(r8), intent(in) :: td + real(kp), intent(in) :: td ! - real(r8) :: e - real(r8) :: ai + real(kp) :: e + real(kp) :: ai integer :: i ! e = max(min(td,tmax),tmin) i = int(e-tmin)+1 ai = aint(e-tmin) - estblf = (tmin+ai-e+1._r8)* estbl(i)-(tmin+ai-e)* estbl(i+1) + estblf = (tmin+ai-e+1._kp)* estbl(i)-(tmin+ai-e)* estbl(i+1) end function estblf !>\ingroup wv_saturation_mod @@ -110,19 +110,19 @@ subroutine gestbl(tmn ,tmx ,trice ,ip ,epsil , latvap ,latice , & ! ! Input arguments ! - real(r8), intent(in) :: tmn - real(r8), intent(in) :: tmx - real(r8), intent(in) :: epsil - real(r8), intent(in) :: trice - real(r8), intent(in) :: latvap - real(r8), intent(in) :: latice - real(r8), intent(in) :: rh2o - real(r8), intent(in) :: cpair - real(r8), intent(in) :: tmeltx + real(kp), intent(in) :: tmn + real(kp), intent(in) :: tmx + real(kp), intent(in) :: epsil + real(kp), intent(in) :: trice + real(kp), intent(in) :: latvap + real(kp), intent(in) :: latice + real(kp), intent(in) :: rh2o + real(kp), intent(in) :: cpair + real(kp), intent(in) :: tmeltx ! !---------------------------Local variables----------------------------- ! - real(r8) t + real(kp) t integer n integer lentbl integer itype @@ -148,7 +148,7 @@ subroutine gestbl(tmn ,tmx ,trice ,ip ,epsil , latvap ,latice , & cp = cpair tmelt = tmeltx ! - lentbl = INT(tmax-tmin+2.000001_r8) + lentbl = INT(tmax-tmin+2.000001_kp) if (lentbl .gt. plenest) then @@ -162,7 +162,7 @@ subroutine gestbl(tmn ,tmx ,trice ,ip ,epsil , latvap ,latice , & ! If so, set appropriate transition range for temperature ! if (icephs) then - if (ttrice /= 0.0_r8) then + if (ttrice /= 0.0_kp) then itype = -ttrice else itype = 1 @@ -171,14 +171,14 @@ subroutine gestbl(tmn ,tmx ,trice ,ip ,epsil , latvap ,latice , & itype = 0 end if ! - t = tmin - 1.0_r8 + t = tmin - 1.0_kp do n=1,lentbl - t = t + 1.0_r8 + t = t + 1.0_kp call gffgch(t,estbl(n),tmelt,itype) end do ! do n=lentbl+1,plenest - estbl(n) = -99999.0_r8 + estbl(n) = -99999.0_kp end do ! ! Table complete -- Set coefficients for polynomial approximation of @@ -188,11 +188,11 @@ subroutine gestbl(tmn ,tmx ,trice ,ip ,epsil , latvap ,latice , & ! ! --- Degree 5 approximation --- ! - pcf(1) = 5.04469588506e-01_r8 - pcf(2) = -5.47288442819e+00_r8 - pcf(3) = -3.67471858735e-01_r8 - pcf(4) = -8.95963532403e-03_r8 - pcf(5) = -7.78053686625e-05_r8 + pcf(1) = 5.04469588506e-01_kp + pcf(2) = -5.47288442819e+00_kp + pcf(3) = -3.67471858735e-01_kp + pcf(4) = -8.95963532403e-03_kp + pcf(5) = -7.78053686625e-05_kp ! ! --- Degree 6 approximation --- ! @@ -235,35 +235,35 @@ subroutine aqsat(t ,p ,es ,qs ,ii , ilen ,kk ,kstart ,kend ) integer, intent(in) :: ilen integer, intent(in) :: kstart integer, intent(in) :: kend - real(r8), intent(in) :: t(ii,kk) - real(r8), intent(in) :: p(ii,kk) + real(kp), intent(in) :: t(ii,kk) + real(kp), intent(in) :: p(ii,kk) ! ! Output arguments ! - real(r8), intent(out) :: es(ii,kk) - real(r8), intent(out) :: qs(ii,kk) + real(kp), intent(out) :: es(ii,kk) + real(kp), intent(out) :: qs(ii,kk) ! !---------------------------Local workspace----------------------------- ! - real(r8) omeps + real(kp) omeps integer i, k ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do k=kstart,kend do i=1,ilen es(i,k) = min(estblf(t(i,k)),p(i,k)) ! ! Saturation specific humidity ! - qs(i,k) = min(1.0_r8, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) + qs(i,k) = min(1.0_kp, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) ! ! The following check is to avoid the generation of negative values ! that can occur in the upper stratosphere and mesosphere ! -! if (qs(i,k) < 0.0_r8) then -! qs(i,k) = 1.0_r8 +! if (qs(i,k) < 0.0_kp) then +! qs(i,k) = 1.0_kp ! es(i,k) = p(i,k) ! end if @@ -291,22 +291,22 @@ subroutine aqsat_water(t, p, es, qs, ii, ilen, kk, kstart,kend) integer, intent(in) :: ilen integer, intent(in) :: kstart integer, intent(in) :: kend - real(r8), intent(in) :: t(ii,kk) - real(r8), intent(in) :: p(ii,kk) + real(kp), intent(in) :: t(ii,kk) + real(kp), intent(in) :: p(ii,kk) ! ! Output arguments ! - real(r8), intent(out) :: es(ii,kk) - real(r8), intent(out) :: qs(ii,kk) + real(kp), intent(out) :: es(ii,kk) + real(kp), intent(out) :: qs(ii,kk) ! !---------------------------Local workspace----------------------------- ! - real(r8) omeps + real(kp) omeps integer i, k ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do k=kstart,kend do i=1,ilen ! es(i,k) = estblf(t(i,k)) @@ -319,13 +319,13 @@ subroutine aqsat_water(t, p, es, qs, ii, ilen, kk, kstart,kend) ! ! Saturation specific humidity ! - qs(i,k) = min(1.0_r8, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) + qs(i,k) = min(1.0_kp, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) ! ! The following check is to avoid the generation of negative values ! that can occur in the upper stratosphere and mesosphere ! -! if (qs(i,k) < 0.0_r8) then -! qs(i,k) = 1.0_r8 +! if (qs(i,k) < 0.0_kp) then +! qs(i,k) = 1.0_kp ! es(i,k) = p(i,k) ! end if end do @@ -357,48 +357,48 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) integer, intent(in) :: kstart integer, intent(in) :: kend - real(r8), intent(in) :: t(ii,kk) - real(r8), intent(in) :: p(ii,kk) + real(kp), intent(in) :: t(ii,kk) + real(kp), intent(in) :: p(ii,kk) ! ! Output arguments ! - real(r8), intent(out) :: es(ii,kk) - real(r8), intent(out) :: qs(ii,kk) - real(r8), intent(out) :: gam(ii,kk) + real(kp), intent(out) :: es(ii,kk) + real(kp), intent(out) :: qs(ii,kk) + real(kp), intent(out) :: gam(ii,kk) ! !---------------------------Local workspace----------------------------- ! logical lflg integer i integer k - real(r8) omeps - real(r8) trinv - real(r8) tc - real(r8) weight - real(r8) hltalt - real(r8) hlatsb - real(r8) hlatvp - real(r8) tterm - real(r8) desdt + real(kp) omeps + real(kp) trinv + real(kp) tc + real(kp) weight + real(kp) hltalt + real(kp) hlatsb + real(kp) hlatvp + real(kp) tterm + real(kp) desdt ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do k=kstart,kend do i=1,ilen es(i,k) = min(p(i,k), estblf(t(i,k))) ! ! Saturation specific humidity ! - qs(i,k) = min(1.0_r8, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) + qs(i,k) = min(1.0_kp, epsqs*es(i,k)/(p(i,k)-omeps*es(i,k))) ! ! The following check is to avoid the generation of negative qs ! values which can occur in the upper stratosphere and mesosphere ! ! -! if (qs(i,k) < 0.0_r8) then -! qs(i,k) = 1.0_r8 +! if (qs(i,k) < 0.0_kp) then +! qs(i,k) = 1.0_kp ! es(i,k) = p(i,k) ! end if end do @@ -407,9 +407,9 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) ! "generalized" analytic expression for t derivative of es ! accurate to within 1 percent for 173.16 < t < 373.16 ! - trinv = 0.0_r8 - if ((.not. icephs) .or. (ttrice == 0.0_r8)) go to 10 - trinv = 1.0_r8/ttrice + trinv = 0.0_kp + if ((.not. icephs) .or. (ttrice == 0.0_kp)) go to 10 + trinv = 1.0_kp/ttrice ! do k=kstart,kend do i=1,ilen @@ -422,10 +422,10 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) ! above freezing where constant slope is given by -2369 j/(kg c) =cpv - cw ! tc = t(i,k) - tmelt - lflg = (tc >= -ttrice .and. tc < 0.0_r8) - weight = min(-tc*trinv,1.0_r8) + lflg = (tc >= -ttrice .and. tc < 0.0_kp) + weight = min(-tc*trinv,1.0_kp) hlatsb = hlatv + weight*hlatf - hlatvp = hlatv - 2369.0_r8*tc + hlatvp = hlatv - 2369.0_kp*tc if (t(i,k) < tmelt) then hltalt = hlatsb else @@ -435,12 +435,12 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) tterm = pcf(1) + tc*(pcf(2) + tc*(pcf(3) + tc*(pcf(4) & & + tc*pcf(5)))) else - tterm = 0.0_r8 + tterm = 0.0_kp end if desdt = hltalt*es(i,k)/(rgasv*t(i,k)*t(i,k)) + tterm*trinv gam(i,k) = hltalt*qs(i,k)*p(i,k)*desdt/(cp*es(i,k)*(p(i,k) & & - omeps*es(i,k))) - if (qs(i,k) == 1.0_r8) gam(i,k) = 0.0_r8 + if (qs(i,k) == 1.0_kp) gam(i,k) = 0.0_kp end do end do ! @@ -454,7 +454,7 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t(i,k)-tmelt) + hlatvp = hlatv - 2369.0_kp*(t(i,k)-tmelt) if (icephs) then hlatsb = hlatv + hlatf else @@ -468,7 +468,7 @@ subroutine aqsatd(t, p, es, qs, gam, ii, ilen, kk, kstart, kend) desdt = hltalt*es(i,k)/(rgasv*t(i,k)*t(i,k)) gam(i,k) = hltalt*qs(i,k)*p(i,k)*desdt/(cp*es(i,k)*(p(i,k) & & - omeps*es(i,k))) - if (qs(i,k) == 1.0_r8) gam(i,k) = 0.0_r8 + if (qs(i,k) == 1.0_kp) gam(i,k) = 0.0_kp end do end do ! @@ -488,14 +488,14 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! Input arguments ! integer, intent(in) :: len - real(r8), intent(in) :: t(len) - real(r8), intent(in) :: p(len) + real(kp), intent(in) :: t(len) + real(kp), intent(in) :: p(len) ! ! Output arguments ! - real(r8), intent(out) :: es(len) - real(r8), intent(out) :: qs(len) - real(r8), intent(out) :: gam(len) + real(kp), intent(out) :: es(len) + real(kp), intent(out) :: qs(len) + real(kp), intent(out) :: gam(len) ! !--------------------------Local Variables------------------------------ ! @@ -503,20 +503,20 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! integer i ! - real(r8) omeps - real(r8) trinv - real(r8) tc - real(r8) weight - real(r8) hltalt + real(kp) omeps + real(kp) trinv + real(kp) tc + real(kp) weight + real(kp) hltalt ! - real(r8) hlatsb - real(r8) hlatvp - real(r8) tterm - real(r8) desdt + real(kp) hlatsb + real(kp) hlatvp + real(kp) tterm + real(kp) desdt ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do i=1,len es(i) = min(estblf(t(i)), p(i)) ! @@ -527,10 +527,10 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! - qs(i) = min(1.0_r8,qs(i)) + qs(i) = min(1.0_kp,qs(i)) ! -! if (qs(i) < 0.0_r8) then -! qs(i) = 1.0_r8 +! if (qs(i) < 0.0_kp) then +! qs(i) = 1.0_kp ! es(i) = p(i) ! end if @@ -539,9 +539,9 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! "generalized" analytic expression for t derivative of es ! accurate to within 1 percent for 173.16 < t < 373.16 ! - trinv = 0.0_r8 - if ((.not. icephs) .or. (ttrice.eq.0.0_r8)) go to 10 - trinv = 1.0_r8/ttrice + trinv = 0.0_kp + if ((.not. icephs) .or. (ttrice.eq.0.0_kp)) go to 10 + trinv = 1.0_kp/ttrice do i=1,len ! ! Weighting of hlat accounts for transition from water to ice @@ -552,10 +552,10 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! above freezing where const slope is given by -2369 j/(kg c) = cpv - cw ! tc = t(i) - tmelt - lflg = (tc >= -ttrice .and. tc < 0.0_r8) - weight = min(-tc*trinv,1.0_r8) + lflg = (tc >= -ttrice .and. tc < 0.0_kp) + weight = min(-tc*trinv,1.0_kp) hlatsb = hlatv + weight*hlatf - hlatvp = hlatv - 2369.0_r8*tc + hlatvp = hlatv - 2369.0_kp*tc if (t(i) < tmelt) then hltalt = hlatsb else @@ -565,11 +565,11 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) tterm = pcf(1) + tc*(pcf(2) + tc*(pcf(3) + tc*(pcf(4) & & + tc*pcf(5)))) else - tterm = 0.0_r8 + tterm = 0.0_kp end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) + tterm*trinv gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp end do return ! @@ -580,7 +580,7 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t(i)-tmelt) + hlatvp = hlatv - 2369.0_kp*(t(i)-tmelt) if (icephs) then hlatsb = hlatv + hlatf else @@ -593,7 +593,7 @@ subroutine vqsatd(t ,p ,es ,qs ,gam , len ) end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp end do ! return @@ -610,15 +610,15 @@ subroutine vqsatd_water(t, p, es, qs, gam, len) ! Input arguments ! integer, intent(in) :: len - real(r8), intent(in) :: t(len) - real(r8), intent(in) :: p(len) + real(kp), intent(in) :: t(len) + real(kp), intent(in) :: p(len) ! ! Output arguments ! - real(r8), intent(out) :: es(len) - real(r8), intent(out) :: qs(len) - real(r8), intent(out) :: gam(len) + real(kp), intent(out) :: es(len) + real(kp), intent(out) :: qs(len) + real(kp), intent(out) :: gam(len) ! !--------------------------Local Variables------------------------------ @@ -626,16 +626,16 @@ subroutine vqsatd_water(t, p, es, qs, gam, len) ! integer i ! - real(r8) omeps - real(r8) hltalt + real(kp) omeps + real(kp) hltalt ! - real(r8) hlatsb - real(r8) hlatvp - real(r8) desdt + real(kp) hlatsb + real(kp) hlatvp + real(kp) desdt ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do i=1,len #ifdef NEMS_GSM es(i) = min(fpvsl(t(i)), p(i)) @@ -645,15 +645,15 @@ subroutine vqsatd_water(t, p, es, qs, gam, len) ! ! Saturation specific humidity ! - qs(i) = min(1.0_r8, epsqs*es(i) / (p(i)-omeps*es(i))) + qs(i) = min(1.0_kp, epsqs*es(i) / (p(i)-omeps*es(i))) ! ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! -! qs(i) = min(1.0_r8,qs(i)) +! qs(i) = min(1.0_kp,qs(i)) ! -! if (qs(i) < 0.0_r8) then -! qs(i) = 1.0_r8 +! if (qs(i) < 0.0_kp) then +! qs(i) = 1.0_kp ! es(i) = p(i) ! end if @@ -666,7 +666,7 @@ subroutine vqsatd_water(t, p, es, qs, gam, len) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t(i)-tmelt) + hlatvp = hlatv - 2369.0_kp*(t(i)-tmelt) hlatsb = hlatv if (t(i) < tmelt) then hltalt = hlatsb @@ -675,7 +675,7 @@ subroutine vqsatd_water(t, p, es, qs, gam, len) end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp end do ! return @@ -693,9 +693,9 @@ function polysvp (T,typ) !!DONIFF Changed to Murphy and Koop (2005) (03/04/14) - real(r8) dum + real(kp) dum - real(r8) t,polysvp + real(kp) t,polysvp integer typ @@ -716,19 +716,19 @@ function polysvp (T,typ) - polysvp = 10._r8**(-9.09718_r8*(273.16_r8/t-1._r8)-3.56654_r8* & - & log10(273.16_r8/t)+0.876793_r8*(1._r8-t/273.16_r8)+ & - & log10(6.1071_r8))*100._r8 + polysvp = 10._kp**(-9.09718_kp*(273.16_kp/t-1._kp)-3.56654_kp* & + & log10(273.16_kp/t)+0.876793_kp*(1._kp-t/273.16_kp)+ & + & log10(6.1071_kp))*100._kp end if if (typ.eq.0) then - polysvp = 10._r8**(-7.90298_r8*(373.16_r8/t-1._r8)+ 5.02808_r8* & - &log10(373.16_r8/t)- 1.3816e-7_r8*(10._r8**(11.344_r8*(1._r8-t/ & - &373.16_r8))-1._r8)+ 8.1328e-3_r8*(10._r8**(-3.49149_r8*(373.16_r8/ & - &t-1._r8))-1._r8)+ log10(1013.246_r8))*100._r8 + polysvp = 10._kp**(-7.90298_kp*(373.16_kp/t-1._kp)+ 5.02808_kp* & + &log10(373.16_kp/t)- 1.3816e-7_kp*(10._kp**(11.344_kp*(1._kp-t/ & + &373.16_kp))-1._kp)+ 8.1328e-3_kp*(10._kp**(-3.49149_kp*(373.16_kp/ & + &t-1._kp))-1._kp)+ log10(1013.246_kp))*100._kp end if end if @@ -745,40 +745,40 @@ integer function fqsatd(t ,p ,es ,qs ,gam , len ) integer, intent(in) :: len - real(r8), intent(in) :: t(len) - real(r8), intent(in) :: p(len) + real(kp), intent(in) :: t(len) + real(kp), intent(in) :: p(len) - real(r8), intent(out) :: es(len) - real(r8), intent(out) :: qs(len) - real(r8), intent(out) :: gam(len) + real(kp), intent(out) :: es(len) + real(kp), intent(out) :: qs(len) + real(kp), intent(out) :: gam(len) call vqsatd(t ,p ,es ,qs ,gam , len ) fqsatd = 1 return end function fqsatd - real(r8) function qsat_water(t,p) + real(kp) function qsat_water(t,p) - real(r8) t - real(r8) p - real(r8) es - real(r8) ps, ts, e1, e2, f1, f2, f3, f4, f5, f + real(kp) t + real(kp) p + real(kp) es + real(kp) ps, ts, e1, e2, f1, f2, f3, f4, f5, f - ps = 1013.246_r8 - ts = 373.16_r8 - e1 = 11.344_r8*(1.0_r8 - t/ts) - e2 = -3.49149_r8*(ts/t - 1.0_r8) - f1 = -7.90298_r8*(ts/t - 1.0_r8) - f2 = 5.02808_r8*log10(ts/t) - f3 = -1.3816_r8*(10.0_r8**e1 - 1.0_r8)/10000000.0_r8 - f4 = 8.1328_r8*(10.0_r8**e2 - 1.0_r8)/1000.0_r8 + ps = 1013.246_kp + ts = 373.16_kp + e1 = 11.344_kp*(1.0_kp - t/ts) + e2 = -3.49149_kp*(ts/t - 1.0_kp) + f1 = -7.90298_kp*(ts/t - 1.0_kp) + f2 = 5.02808_kp*log10(ts/t) + f3 = -1.3816_kp*(10.0_kp**e1 - 1.0_kp)/10000000.0_kp + f4 = 8.1328_kp*(10.0_kp**e2 - 1.0_kp)/1000.0_kp f5 = log10(ps) f = f1 + f2 + f3 + f4 + f5 - es = (10.0_r8**f)*100.0_r8 + es = (10.0_kp**f)*100.0_kp qsat_water = epsqs*es/(p-(1.-epsqs)*es) if(qsat_water < 0.) qsat_water = 1. @@ -790,17 +790,17 @@ end function qsat_water subroutine vqsat_water(t,p,qsat_water,len) integer, intent(in) :: len - real(r8) t(len) - real(r8) p(len) - real(r8) qsat_water(len) - real(r8) es - real(r8), parameter :: t0inv = 1._r8/273._r8 - real(r8) coef + real(kp) t(len) + real(kp) p(len) + real(kp) qsat_water(len) + real(kp) es + real(kp), parameter :: t0inv = 1._kp/273._kp + real(kp) coef integer :: i coef = hlatv/rgasv do i=1,len - es = 611._r8*exp(coef*(t0inv-1./t(i))) + es = 611._kp*exp(coef*(t0inv-1./t(i))) qsat_water(i) = epsqs*es/(p(i)-(1.-epsqs)*es) if(qsat_water(i) < 0.) qsat_water(i) = 1. enddo @@ -810,12 +810,12 @@ subroutine vqsat_water(t,p,qsat_water,len) end subroutine vqsat_water !>\ingroup wv_saturation_mod - real(r8) function qsat_ice(t,p) + real(kp) function qsat_ice(t,p) - real(r8) t - real(r8) p - real(r8) es - real(r8), parameter :: t0inv = 1._r8/273._r8 + real(kp) t + real(kp) p + real(kp) es + real(kp), parameter :: t0inv = 1._kp/273._kp es = 611.*exp((hlatv+hlatf)/rgasv*(t0inv-1./t)) qsat_ice = epsqs*es/(p-(1.-epsqs)*es) if(qsat_ice < 0.) qsat_ice = 1. @@ -826,12 +826,12 @@ end function qsat_ice subroutine vqsat_ice(t,p,qsat_ice,len) integer,intent(in) :: len - real(r8) t(len) - real(r8) p(len) - real(r8) qsat_ice(len) - real(r8) es - real(r8), parameter :: t0inv = 1._r8/273._r8 - real(r8) coef + real(kp) t(len) + real(kp) p(len) + real(kp) qsat_ice(len) + real(kp) es + real(kp), parameter :: t0inv = 1._kp/273._kp + real(kp) coef integer :: i coef = (hlatv+hlatf)/rgasv @@ -858,17 +858,17 @@ subroutine vqsatd2_water(t ,p ,es ,qs ,dqsdt , len ) ! Input arguments ! integer, intent(in) :: len - real(r8), intent(in) :: t(len) - real(r8), intent(in) :: p(len) + real(kp), intent(in) :: t(len) + real(kp), intent(in) :: p(len) ! ! Output arguments ! - real(r8), intent(out) :: es(len) - real(r8), intent(out) :: qs(len) + real(kp), intent(out) :: es(len) + real(kp), intent(out) :: qs(len) - real(r8), intent(out) :: dqsdt(len) + real(kp), intent(out) :: dqsdt(len) ! @@ -877,21 +877,21 @@ subroutine vqsatd2_water(t ,p ,es ,qs ,dqsdt , len ) ! integer i ! - real(r8) omeps - real(r8) hltalt + real(kp) omeps + real(kp) hltalt ! - real(r8) hlatsb - real(r8) hlatvp - real(r8) desdt + real(kp) hlatsb + real(kp) hlatvp + real(kp) desdt - real(r8) gam(len) + real(kp) gam(len) ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do i=1,len #ifdef GEOS5 es(i) = min(polysvp(t(i),0), p(i)) @@ -907,10 +907,10 @@ subroutine vqsatd2_water(t ,p ,es ,qs ,dqsdt , len ) ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! - qs(i) = min(1.0_r8,qs(i)) + qs(i) = min(1.0_kp,qs(i)) ! -! if (qs(i) < 0.0_r8) then -! qs(i) = 1.0_r8 +! if (qs(i) < 0.0_kp) then +! qs(i) = 1.0_kp ! es(i) = p(i) ! end if @@ -923,7 +923,7 @@ subroutine vqsatd2_water(t ,p ,es ,qs ,dqsdt , len ) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t(i)-tmelt) + hlatvp = hlatv - 2369.0_kp*(t(i)-tmelt) hlatsb = hlatv if (t(i) < tmelt) then hltalt = hlatsb @@ -932,7 +932,7 @@ subroutine vqsatd2_water(t ,p ,es ,qs ,dqsdt , len ) end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp dqsdt(i) = (cp/hltalt)*gam(i) @@ -950,22 +950,22 @@ subroutine vqsatd2_water_single(t ,p ,es ,qs ,dqsdt) ! Input arguments ! - real(r8), intent(in) :: t, p + real(kp), intent(in) :: t, p ! ! Output arguments ! - real(r8), intent(out) :: es, qs, dqsdt + real(kp), intent(out) :: es, qs, dqsdt ! !--------------------------Local Variables------------------------------ ! ! integer i ! - real(r8) omeps, hltalt, hlatsb, hlatvp, desdt, gam + real(kp) omeps, hltalt, hlatsb, hlatvp, desdt, gam ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs ! do i=1,len #ifdef GEOS5 es = min(p, polysvp(t,0)) @@ -976,13 +976,13 @@ subroutine vqsatd2_water_single(t ,p ,es ,qs ,dqsdt) ! ! Saturation specific humidity ! - qs = min(1.0_r8, epsqs*es/(p-omeps*es)) + qs = min(1.0_kp, epsqs*es/(p-omeps*es)) ! ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! -! if (qs < 0.0_r8) then -! qs = 1.0_r8 +! if (qs < 0.0_kp) then +! qs = 1.0_kp ! es = p ! end if ! end do @@ -994,7 +994,7 @@ subroutine vqsatd2_water_single(t ,p ,es ,qs ,dqsdt) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t-tmelt) + hlatvp = hlatv - 2369.0_kp*(t-tmelt) hlatsb = hlatv if (t < tmelt) then hltalt = hlatsb @@ -1003,7 +1003,7 @@ subroutine vqsatd2_water_single(t ,p ,es ,qs ,dqsdt) end if desdt = hltalt*es/(rgasv*t*t) gam = hltalt*qs*p*desdt/(cp*es*(p - omeps*es)) - if (qs >= 1.0_r8) gam = 0.0_r8 + if (qs >= 1.0_kp) gam = 0.0_kp dqsdt = (cp/hltalt)*gam @@ -1035,16 +1035,16 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! Input arguments ! integer, intent(in) :: len - real(r8), intent(in) :: t(len) - real(r8), intent(in) :: p(len) + real(kp), intent(in) :: t(len) + real(kp), intent(in) :: p(len) ! ! Output arguments ! - real(r8), intent(out) :: es(len) - real(r8), intent(out) :: qs(len) + real(kp), intent(out) :: es(len) + real(kp), intent(out) :: qs(len) - real(r8), intent(out) :: dqsdt(len) + real(kp), intent(out) :: dqsdt(len) ! @@ -1054,24 +1054,24 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! integer i ! - real(r8) omeps - real(r8) trinv - real(r8) tc - real(r8) weight - real(r8) hltalt + real(kp) omeps + real(kp) trinv + real(kp) tc + real(kp) weight + real(kp) hltalt ! - real(r8) hlatsb - real(r8) hlatvp - real(r8) tterm - real(r8) desdt + real(kp) hlatsb + real(kp) hlatvp + real(kp) tterm + real(kp) desdt - real(r8) gam(len) + real(kp) gam(len) ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs do i=1,len #ifdef GEOS5 es(i) = min(p(i), estblf(t(i))) @@ -1087,10 +1087,10 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! - qs(i) = min(1.0_r8,qs(i)) + qs(i) = min(1.0_kp,qs(i)) ! -! if (qs(i) < 0.0_r8) then -! qs(i) = 1.0_r8 +! if (qs(i) < 0.0_kp) then +! qs(i) = 1.0_kp ! es(i) = p(i) ! end if end do @@ -1098,9 +1098,9 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! "generalized" analytic expression for t derivative of es ! accurate to within 1 percent for 173.16 < t < 373.16 ! - trinv = 0.0_r8 - if ((.not. icephs) .or. (ttrice == 0.0_r8)) go to 10 - trinv = 1.0_r8/ttrice + trinv = 0.0_kp + if ((.not. icephs) .or. (ttrice == 0.0_kp)) go to 10 + trinv = 1.0_kp/ttrice do i=1,len ! ! Weighting of hlat accounts for transition from water to ice @@ -1111,10 +1111,10 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! above freezing where const slope is given by -2369 j/(kg c) = cpv - cw ! tc = t(i) - tmelt - lflg = (tc >= -ttrice .and. tc < 0.0_r8) - weight = min(-tc*trinv,1.0_r8) + lflg = (tc >= -ttrice .and. tc < 0.0_kp) + weight = min(-tc*trinv,1.0_kp) hlatsb = hlatv + weight*hlatf - hlatvp = hlatv - 2369.0_r8*tc + hlatvp = hlatv - 2369.0_kp*tc if (t(i) < tmelt) then hltalt = hlatsb else @@ -1124,11 +1124,11 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) tterm = pcf(1) + tc*(pcf(2) + tc*(pcf(3) + tc*(pcf(4) & & + tc*pcf(5)))) else - tterm = 0.0_r8 + tterm = 0.0_kp end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) + tterm*trinv gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp dqsdt(i) = (cp/hltalt)*gam(i) @@ -1142,7 +1142,7 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t(i)-tmelt) + hlatvp = hlatv - 2369.0_kp*(t(i)-tmelt) if (icephs) then hlatsb = hlatv + hlatf else @@ -1155,7 +1155,7 @@ subroutine vqsatd2(t ,p ,es ,qs ,dqsdt , len ) end if desdt = hltalt*es(i)/(rgasv*t(i)*t(i)) gam(i) = hltalt*qs(i)*p(i)*desdt/(cp*es(i)*(p(i) - omeps*es(i))) - if (qs(i) == 1.0_r8) gam(i) = 0.0_r8 + if (qs(i) == 1.0_kp) gam(i) = 0.0_kp dqsdt(i) = (cp/hltalt)*gam(i) @@ -1189,11 +1189,11 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! ! Input arguments ! - real(r8), intent(in) :: t, p + real(kp), intent(in) :: t, p ! ! Output arguments ! - real(r8), intent(out) :: es, qs, dqsdt + real(kp), intent(out) :: es, qs, dqsdt ! !--------------------------Local Variables------------------------------ ! @@ -1201,23 +1201,23 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! ! integer i ! index for vector calculations ! - real(r8) omeps - real(r8) trinv - real(r8) tc - real(r8) weight - real(r8) hltalt + real(kp) omeps + real(kp) trinv + real(kp) tc + real(kp) weight + real(kp) hltalt ! - real(r8) hlatsb - real(r8) hlatvp - real(r8) tterm - real(r8) desdt + real(kp) hlatsb + real(kp) hlatvp + real(kp) tterm + real(kp) desdt - real(r8) gam + real(kp) gam ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs ! do i=1,len @@ -1235,10 +1235,10 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! - qs = min(1.0_r8,qs) + qs = min(1.0_kp,qs) ! -! if (qs < 0.0_r8) then -! qs = 1.0_r8 +! if (qs < 0.0_kp) then +! qs = 1.0_kp ! es = p ! end if @@ -1247,9 +1247,9 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! "generalized" analytic expression for t derivative of es ! accurate to within 1 percent for 173.16 < t < 373.16 ! - trinv = 0.0_r8 - if ((.not. icephs) .or. (ttrice == 0.0_r8)) go to 10 - trinv = 1.0_r8/ttrice + trinv = 0.0_kp + if ((.not. icephs) .or. (ttrice == 0.0_kp)) go to 10 + trinv = 1.0_kp/ttrice ! do i=1,len ! @@ -1261,10 +1261,10 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! above freezing where const slope is given by -2369 j/(kg c) = cpv - cw ! tc = t - tmelt - lflg = (tc >= -ttrice .and. tc < 0.0_r8) - weight = min(-tc*trinv,1.0_r8) + lflg = (tc >= -ttrice .and. tc < 0.0_kp) + weight = min(-tc*trinv,1.0_kp) hlatsb = hlatv + weight*hlatf - hlatvp = hlatv - 2369.0_r8*tc + hlatvp = hlatv - 2369.0_kp*tc if (t < tmelt) then hltalt = hlatsb else @@ -1274,11 +1274,11 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) tterm = pcf(1) + tc*(pcf(2) + tc*(pcf(3) + tc*(pcf(4) & & + tc*pcf(5)))) else - tterm = 0.0_r8 + tterm = 0.0_kp end if desdt = hltalt*es/(rgasv*t*t) + tterm*trinv gam = hltalt*qs*p*desdt/(cp*es*(p - omeps*es)) - if (qs == 1.0_r8) gam = 0.0_r8 + if (qs == 1.0_kp) gam = 0.0_kp dqsdt = (cp/hltalt)*gam @@ -1295,7 +1295,7 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) ! Account for change of hlatv with t above freezing where ! constant slope is given by -2369 j/(kg c) = cpv - cw ! - hlatvp = hlatv - 2369.0_r8*(t-tmelt) + hlatvp = hlatv - 2369.0_kp*(t-tmelt) if (icephs) then hlatsb = hlatv + hlatf else @@ -1308,7 +1308,7 @@ subroutine vqsatd2_single(t ,p ,es ,qs ,dqsdt) end if desdt = hltalt*es/(rgasv*t*t) gam = hltalt*qs*p*desdt/(cp*es*(p - omeps*es)) - if (qs == 1.0_r8) gam = 0.0_r8 + if (qs == 1.0_kp) gam = 0.0_kp dqsdt = (cp/hltalt)*gam @@ -1360,33 +1360,33 @@ subroutine gffgch(t ,es ,tmelt ,itype ) ! ! Input arguments ! - real(r8), intent(in) :: t ,tmelt + real(kp), intent(in) :: t ,tmelt ! ! Output arguments ! integer, intent(inout) :: itype - real(r8), intent(out) :: es + real(kp), intent(out) :: es ! !---------------------------Local variables----------------------------- ! - real(r8) e1 - real(r8) e2 - real(r8) eswtr - real(r8) f - real(r8) f1 - real(r8) f2 - real(r8) f3 - real(r8) f4 - real(r8) f5 - real(r8) ps - real(r8) t0 - real(r8) term1 - real(r8) term2 - real(r8) term3 - real(r8) tr - real(r8) ts - real(r8) weight + real(kp) e1 + real(kp) e2 + real(kp) eswtr + real(kp) f + real(kp) f1 + real(kp) f2 + real(kp) f3 + real(kp) f4 + real(kp) f5 + real(kp) ps + real(kp) t0 + real(kp) term1 + real(kp) term2 + real(kp) term3 + real(kp) tr + real(kp) ts + real(kp) weight integer itypo ! !----------------------------------------------------------------------- @@ -1394,14 +1394,14 @@ subroutine gffgch(t ,es ,tmelt ,itype ) ! Check on whether there is to be a transition region for es ! if (itype < 0) then - tr = abs(real(itype,r8)) + tr = abs(real(itype,kp)) itypo = itype itype = 1 else - tr = 0.0_r8 + tr = 0.0_kp itypo = itype end if - if (tr > 40.0_r8) then + if (tr > 40.0_kp) then write(iulog,900) tr end if @@ -1410,17 +1410,17 @@ subroutine gffgch(t ,es ,tmelt ,itype ) ! ! Water ! - ps = 1013.246_r8 - ts = 373.16_r8 - e1 = 11.344_r8*(1.0_r8 - t/ts) - e2 = -3.49149_r8*(ts/t - 1.0_r8) - f1 = -7.90298_r8*(ts/t - 1.0_r8) - f2 = 5.02808_r8*log10(ts/t) - f3 = -1.3816_r8*(10.0_r8**e1 - 1.0_r8)/10000000.0_r8 - f4 = 8.1328_r8*(10.0_r8**e2 - 1.0_r8)/1000.0_r8 + ps = 1013.246_kp + ts = 373.16_kp + e1 = 11.344_kp*(1.0_kp - t/ts) + e2 = -3.49149_kp*(ts/t - 1.0_kp) + f1 = -7.90298_kp*(ts/t - 1.0_kp) + f2 = 5.02808_kp*log10(ts/t) + f3 = -1.3816_kp*(10.0_kp**e1 - 1.0_kp)/10000000.0_kp + f4 = 8.1328_kp*(10.0_kp**e2 - 1.0_kp)/1000.0_kp f5 = log10(ps) f = f1 + f2 + f3 + f4 + f5 - es = (10.0_r8**f)*100.0_r8 + es = (10.0_kp**f)*100.0_kp eswtr = es ! if(t >= tmelt .or. itype == 0) go to 20 @@ -1429,17 +1429,17 @@ subroutine gffgch(t ,es ,tmelt ,itype ) ! 10 continue t0 = tmelt - term1 = 2.01889049_r8/(t0/t) - term2 = 3.56654_r8*log(t0/t) - term3 = 20.947031_r8*(t0/t) - es = 575.185606e10_r8*exp(-(term1 + term2 + term3)) + term1 = 2.01889049_kp/(t0/t) + term2 = 3.56654_kp*log(t0/t) + term3 = 20.947031_kp*(t0/t) + es = 575.185606e10_kp*exp(-(term1 + term2 + term3)) ! if (t < (tmelt - tr)) go to 20 ! ! Weighted transition between water and ice ! - weight = min((tmelt - t)/tr,1.0_r8) - es = weight*es + (1.0_r8 - weight)*eswtr + weight = min((tmelt - t)/tr,1.0_kp) + es = weight*es + (1.0_kp - weight)*eswtr ! 20 continue itype = itypo @@ -1455,31 +1455,31 @@ end subroutine gffgch !>\ingroup wv_saturation_mod !!DONIF USe Murphy and Koop (2005) (Written by Andrew Gettelman) function MurphyKoop_svp_water(tx) result(es) - real(r8), intent(in) :: tx - real(r8) :: es - real(r8):: t + real(kp), intent(in) :: tx + real(kp) :: es + real(kp):: t - t=min(tx, 332.0_r8) - t=max(123.0_r8, tx) + t=min(tx, 332.0_kp) + t=max(123.0_kp, tx) - es = exp(54.842763_r8 - (6763.22_r8 / t) - (4.210_r8 * log(t)) + & - & (0.000367_r8 * t) + (tanh(0.0415_r8 * (t - 218.8_r8)) * & - & (53.878_r8 - (1331.22_r8 / t) - (9.44523_r8 * log(t)) + & - & 0.014025_r8 * t))) + es = exp(54.842763_kp - (6763.22_kp / t) - (4.210_kp * log(t)) + & + & (0.000367_kp * t) + (tanh(0.0415_kp * (t - 218.8_kp)) * & + & (53.878_kp - (1331.22_kp / t) - (9.44523_kp * log(t)) + & + & 0.014025_kp * t))) end function MurphyKoop_svp_water function MurphyKoop_svp_ice(tx) result(es) - real(r8), intent(in) :: tx - real(r8) :: t - real(r8) :: es + real(kp), intent(in) :: tx + real(kp) :: t + real(kp) :: es - t=max(100.0_r8, tx) - t=min(274.0_r8, tx) + t=max(100.0_kp, tx) + t=min(274.0_kp, tx) - es = exp(9.550426_r8 - (5723.265_r8 / t) + (3.53068_r8 * & - & log(t)) - (0.00728332_r8 * t)) + es = exp(9.550426_kp - (5723.265_kp / t) + (3.53068_kp * & + & log(t)) - (0.00728332_kp * t)) end function MurphyKoop_svp_ice !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1490,22 +1490,22 @@ subroutine vqsatd2_ice_single(t ,p ,es ,qs ,dqsdt) ! ! Input arguments ! - real(r8), intent(in) :: t, p + real(kp), intent(in) :: t, p ! ! Output arguments ! - real(r8), intent(out) :: es, qs, dqsdt + real(kp), intent(out) :: es, qs, dqsdt ! !--------------------------Local Variables------------------------------ ! ! integer i ! - real(r8) omeps, hltalt, hlatsb, hlatvp, desdt, gam + real(kp) omeps, hltalt, hlatsb, hlatvp, desdt, gam ! !----------------------------------------------------------------------- ! - omeps = 1.0_r8 - epsqs + omeps = 1.0_kp - epsqs ! do i=1,len #ifdef GEOS5 es = min(polysvp(t,1),p) @@ -1516,13 +1516,13 @@ subroutine vqsatd2_ice_single(t ,p ,es ,qs ,dqsdt) ! ! Saturation specific humidity ! - qs = min(1.0_r8, epsqs*es/(p-omeps*es)) + qs = min(1.0_kp, epsqs*es/(p-omeps*es)) ! ! The following check is to avoid the generation of negative ! values that can occur in the upper stratosphere and mesosphere ! -! if (qs < 0.0_r8) then -! qs = 1.0_r8 +! if (qs < 0.0_kp) then +! qs = 1.0_kp ! es = p ! end if ! end do @@ -1536,10 +1536,10 @@ subroutine vqsatd2_ice_single(t ,p ,es ,qs ,dqsdt) ! hltalt = hlatv + hlatf desdt = hltalt*es/(rgasv*t*t) - if (qs < 1.0_r8) then + if (qs < 1.0_kp) then gam = hltalt*qs*p*desdt/(cp*es*(p - omeps*es)) else - gam = 0.0_r8 + gam = 0.0_kp endif dqsdt = (cp/hltalt)*gam From 1378450792e0327a390fb821af49a559852dbddb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 4 Aug 2020 13:44:14 -0600 Subject: [PATCH 40/97] Add first set of dependencies to metadata files for testing --- physics/cires_ugwp.meta | 7 +++++++ physics/mp_thompson.meta | 6 ++++++ physics/mp_thompson_pre.meta | 4 ++++ 3 files changed, 17 insertions(+) diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index d323324d2..03c8b9f32 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -1,3 +1,10 @@ +[ccpp-scheme-properties] + name = cires_ugwp + type = properties +# DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp! + dependencies = gwdps.f + +######################################################################## [ccpp-arg-table] name = cires_ugwp_init type = scheme diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 5bbd85732..5e502441f 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,3 +1,9 @@ +[ccpp-scheme-properties] + name = mp_thompson + type = properties + dependencies = module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + +######################################################################## [ccpp-arg-table] name = mp_thompson_init type = scheme diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index 5782c10f6..d0b7809f0 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -1,3 +1,7 @@ +[ccpp-scheme-properties] + name = mp_thompson + type = properties + [ccpp-arg-table] name = mp_thompson_pre_run type = scheme From f4353e58058b92f2f195a7b95f6a43d6c012d675 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 4 Aug 2020 15:31:56 -0600 Subject: [PATCH 41/97] Add [ccpp-scheme-properties] section to every metadata table --- physics/GFS_DCNV_generic.meta | 10 +++++ physics/GFS_GWD_generic.meta | 13 +++++-- physics/GFS_MP_generic.meta | 10 +++++ physics/GFS_PBL_generic.meta | 10 +++++ physics/GFS_SCNV_generic.meta | 10 +++++ physics/GFS_debug.meta | 20 ++++++++++ physics/GFS_phys_time_vary.fv3.meta | 5 +++ physics/GFS_phys_time_vary.scm.meta | 5 +++ physics/GFS_rad_time_vary.fv3.meta | 5 +++ physics/GFS_rad_time_vary.scm.meta | 5 +++ physics/GFS_rrtmg_post.meta | 5 +++ physics/GFS_rrtmg_pre.meta | 5 +++ physics/GFS_rrtmg_setup.meta | 5 +++ physics/GFS_rrtmgp_lw_post.meta | 5 +++ physics/GFS_rrtmgp_pre.meta | 5 +++ physics/GFS_rrtmgp_setup.meta | 5 +++ physics/GFS_rrtmgp_sw_post.meta | 5 +++ physics/GFS_rrtmgp_sw_pre.meta | 5 +++ physics/GFS_stochastics.meta | 5 +++ physics/GFS_suite_interstitial.meta | 45 ++++++++++++++++++++++ physics/GFS_surface_composites.meta | 15 ++++++++ physics/GFS_surface_generic.meta | 10 +++++ physics/GFS_surface_loop_control.meta | 10 +++++ physics/GFS_time_vary_pre.fv3.meta | 5 +++ physics/GFS_time_vary_pre.scm.meta | 5 +++ physics/cires_ugwp_post.meta | 5 +++ physics/cnvc90.meta | 5 +++ physics/cs_conv.meta | 15 ++++++++ physics/cs_conv_aw_adj.meta | 5 +++ physics/cu_gf_driver.meta | 5 +++ physics/cu_gf_driver_post.meta | 5 +++ physics/cu_gf_driver_pre.meta | 5 +++ physics/cu_ntiedtke.meta | 5 +++ physics/cu_ntiedtke_post.meta | 5 +++ physics/cu_ntiedtke_pre.meta | 5 +++ physics/dcyc2.meta | 5 +++ physics/drag_suite.meta | 5 +++ physics/flake_driver.meta | 5 +++ physics/gcm_shoc.meta | 5 +++ physics/get_prs_fv3.meta | 10 +++++ physics/gfdl_cloud_microphys.meta | 5 +++ physics/gfdl_fv_sat_adj.meta | 5 +++ physics/gmtb_scm_sfc_flux_spec.meta | 5 +++ physics/gscond.meta | 5 +++ physics/gwdc.meta | 15 ++++++++ physics/gwdps.meta | 5 +++ physics/h2ophys.meta | 5 +++ physics/lsm_ruc_sfc_sice_interstitial.meta | 10 +++++ physics/m_micro.meta | 5 +++ physics/m_micro_interstitial.meta | 10 +++++ physics/machine.meta | 5 +++ physics/maximum_hourly_diagnostics.meta | 5 +++ physics/module_MYJPBL_wrapper.meta | 5 +++ physics/module_MYJSFC_wrapper.meta | 5 +++ physics/module_MYNNPBL_wrapper.meta | 5 +++ physics/module_MYNNSFC_wrapper.meta | 5 +++ physics/module_SGSCloud_RadPost.meta | 5 +++ physics/module_SGSCloud_RadPre.meta | 5 +++ physics/moninedmf.meta | 5 +++ physics/moninedmf_hafs.meta | 5 +++ physics/moninshoc.meta | 5 +++ physics/mp_fer_hires.meta | 5 +++ physics/mp_thompson_post.meta | 5 +++ physics/mp_thompson_pre.meta | 3 +- physics/ozphys.meta | 5 +++ physics/ozphys_2015.meta | 5 +++ physics/phys_tend.meta | 5 +++ physics/precpd.meta | 5 +++ physics/radlw_main.meta | 5 +++ physics/radsw_main.meta | 5 +++ physics/rascnv.meta | 5 +++ physics/rayleigh_damp.meta | 5 +++ physics/rrtmg_lw_post.meta | 5 +++ physics/rrtmg_lw_pre.meta | 5 +++ physics/rrtmg_sw_post.meta | 5 +++ physics/rrtmg_sw_pre.meta | 5 +++ physics/rrtmgp_lw_aerosol_optics.meta | 5 +++ physics/rrtmgp_lw_cloud_optics.meta | 5 +++ physics/rrtmgp_lw_cloud_sampling.meta | 5 +++ physics/rrtmgp_lw_gas_optics.meta | 5 +++ physics/rrtmgp_lw_pre.meta | 5 +++ physics/rrtmgp_lw_rte.meta | 5 +++ physics/rrtmgp_sw_aerosol_optics.meta | 5 +++ physics/rrtmgp_sw_cloud_optics.meta | 5 +++ physics/rrtmgp_sw_cloud_sampling.meta | 5 +++ physics/rrtmgp_sw_gas_optics.meta | 5 +++ physics/rrtmgp_sw_rte.meta | 5 +++ physics/samfdeepcnv.meta | 5 +++ physics/samfshalcnv.meta | 5 +++ physics/sascnvn.meta | 5 +++ physics/satmedmfvdif.meta | 5 +++ physics/satmedmfvdifq.meta | 5 +++ physics/sfc_cice.meta | 5 +++ physics/sfc_diag.meta | 5 +++ physics/sfc_diag_post.meta | 5 +++ physics/sfc_diff.meta | 5 +++ physics/sfc_drv.meta | 5 +++ physics/sfc_drv_ruc.meta | 5 +++ physics/sfc_noahmp_drv.meta | 5 +++ physics/sfc_nst.meta | 33 +++++----------- physics/sfc_ocean.meta | 5 +++ physics/sfc_sice.meta | 5 +++ physics/shalcnv.meta | 5 +++ physics/shinhongvdif.meta | 5 +++ physics/ysuvdif.meta | 5 +++ 105 files changed, 660 insertions(+), 29 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 85a7cfa74..6d04019bc 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_DCNV_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_DCNV_generic_pre_run type = scheme @@ -148,6 +153,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_DCNV_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_DCNV_generic_post_run diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 614184975..0b80ee934 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_GWD_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_GWD_generic_pre_init type = scheme @@ -244,10 +249,10 @@ optional = F ######################################################################## -[ccpp-arg-table] - name = GFS_GWD_generic_pre_finalize - type = scheme - +[ccpp-scheme-properties] + name = GFS_GWD_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_GWD_generic_post_run diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 727f735ee..125006cc0 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_MP_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_MP_generic_pre_init type = scheme @@ -138,6 +143,11 @@ name = GFS_MP_generic_pre_finalize type = scheme +######################################################################## +[ccpp-scheme-properties] + name = GFS_MP_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_MP_generic_post_init diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 51962c37b..aa1bedd1c 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_PBL_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_PBL_generic_pre_run type = scheme @@ -412,6 +417,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_PBL_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_PBL_generic_post_run diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index e11e3fbc3..16e30d224 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_SCNV_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_SCNV_generic_pre_run type = scheme @@ -131,6 +136,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_SCNV_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_SCNV_generic_post_run diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index 24d26be7e..5c0c9972a 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_diagtoscreen + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_diagtoscreen_run type = scheme @@ -123,6 +128,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_interstitialtoscreen + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_interstitialtoscreen_run @@ -249,6 +259,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_abort + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_abort_run @@ -287,6 +302,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_checkland + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_checkland_run diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 199cc362c..fdf8e6e3e 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_phys_time_vary + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 57a82ecb0..5087c77dd 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_phys_time_vary + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index c86c81f18..46c536615 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rad_time_vary + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rad_time_vary_init type = scheme diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 7e87f1f8a..3a68ba163 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rad_time_vary + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rad_time_vary_init type = scheme diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 61e89098d..feb0f37c3 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmg_post + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmg_post_init type = scheme diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index a06e718a5..04607f64b 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmg_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmg_pre_init type = scheme diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 3ca93ffd4..dd078dd4d 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmg_setup + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmg_setup_init type = scheme diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index dbe96120d..15be791ab 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmgp_lw_post + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_lw_post_run type = scheme diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index ae94ddf20..92ac1c357 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmgp_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_pre_init type = scheme diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 9165117c5..876490038 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmgp_setup + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_setup_init type = scheme diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 806bd49e4..b01f3fc3d 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmgp_sw_post + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_sw_post_run type = scheme diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 3a96e1522..e0da4948e 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_rrtmgp_sw_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index bd0dbf487..d1e7fa973 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_stochastics + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_stochastics_run type = scheme diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 37c474335..4ec6e43ff 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_suite_interstitial_rad_reset + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_rad_reset_run type = scheme @@ -35,6 +40,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_phys_reset + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_phys_reset_run @@ -73,6 +83,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_1 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_1_run @@ -262,6 +277,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_2 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_2_run @@ -780,6 +800,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_stateout_reset + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_stateout_reset_run @@ -898,6 +923,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_stateout_update + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_stateout_update_run @@ -1061,6 +1091,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_3 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_3_run @@ -1493,6 +1528,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_4 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_4_run @@ -1807,6 +1847,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_suite_interstitial_5 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_suite_interstitial_5_run diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 9b297ca38..a09d38fe6 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_surface_composites_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_surface_composites_pre_run type = scheme @@ -637,6 +642,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_surface_composites_inter + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_surface_composites_inter_run @@ -781,6 +791,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_surface_composites_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_surface_composites_post_run diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index d37f7ec64..3cd011f97 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_surface_generic_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_surface_generic_pre_run type = scheme @@ -499,6 +504,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_surface_generic_post + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_surface_generic_post_run diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta index 3fe5878f7..52fa7616e 100644 --- a/physics/GFS_surface_loop_control.meta +++ b/physics/GFS_surface_loop_control.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_surface_loop_control_part1 + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_surface_loop_control_part1_run type = scheme @@ -52,6 +57,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = GFS_surface_loop_control_part2 + type = properties + ######################################################################## [ccpp-arg-table] name = GFS_surface_loop_control_part2_run diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index 04f7f1529..0f92e7dae 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_time_vary_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_time_vary_pre_init type = scheme diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 3dc91952e..2c50b215e 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = GFS_time_vary_pre + type = properties + +######################################################################## [ccpp-arg-table] name = GFS_time_vary_pre_init type = scheme diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 1f98aa8a4..2ba9732d4 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cires_ugwp_post + type = properties + +######################################################################## [ccpp-arg-table] name = cires_ugwp_post_init type = scheme diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index 0cf7c22a4..caab909e3 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cnvc90 + type = properties + +######################################################################## [ccpp-arg-table] name = cnvc90_init type = scheme diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index b19a42a5b..9a1eba7a8 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cs_conv_pre + type = properties + +######################################################################## [ccpp-arg-table] name = cs_conv_pre_init type = scheme @@ -178,6 +183,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = cs_conv_post + type = properties + ######################################################################## [ccpp-arg-table] name = cs_conv_post_init @@ -252,6 +262,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = cs_conv + type = properties + ######################################################################## [ccpp-arg-table] name = cs_conv_init diff --git a/physics/cs_conv_aw_adj.meta b/physics/cs_conv_aw_adj.meta index fbbe3770c..29053478c 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/cs_conv_aw_adj.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cs_conv_aw_adj + type = properties + +######################################################################## [ccpp-arg-table] name = cs_conv_aw_adj_run type = scheme diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d684ce331..f4ea2ea64 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_gf_driver + type = properties + +######################################################################## [ccpp-arg-table] name = cu_gf_driver_init type = scheme diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 9a28bc719..60faa7a54 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_gf_driver_post + type = properties + +######################################################################## [ccpp-arg-table] name = cu_gf_driver_post_run type = scheme diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 353bbe889..10995be4b 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_gf_driver_pre + type = properties + +######################################################################## [ccpp-arg-table] name = cu_gf_driver_pre_run type = scheme diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 0e6a3d4b0..17290da5f 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_ntiedtke + type = properties + +######################################################################## [ccpp-arg-table] name = cu_ntiedtke_init type = scheme diff --git a/physics/cu_ntiedtke_post.meta b/physics/cu_ntiedtke_post.meta index a4fea92b3..241adefce 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/cu_ntiedtke_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_ntiedtke_post + type = properties + +######################################################################## [ccpp-arg-table] name = cu_ntiedtke_post_run type = scheme diff --git a/physics/cu_ntiedtke_pre.meta b/physics/cu_ntiedtke_pre.meta index 8fd2448a9..ef154c218 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/cu_ntiedtke_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = cu_ntiedtke_pre + type = properties + +######################################################################## [ccpp-arg-table] name = cu_ntiedtke_pre_run type = scheme diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index e946e3c90..4bca64f1f 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = dcyc2t3 + type = properties + +######################################################################## [ccpp-arg-table] name = dcyc2t3_init type = scheme diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfcac8582..49dea9339 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = drag_suite + type = properties + +######################################################################## [ccpp-arg-table] name = drag_suite_init type = scheme diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index a40016010..353d174c3 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = flake_driver + type = properties + +######################################################################## [ccpp-arg-table] name = flake_driver_init type = scheme diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index c1ed6fbd4..2068428fb 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = shoc + type = properties + +######################################################################## [ccpp-arg-table] name = shoc_run type = scheme diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta index f93d259e1..d1323f182 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/get_prs_fv3.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = get_prs_fv3 + type = properties + +######################################################################## [ccpp-arg-table] name = get_prs_fv3_init type = scheme @@ -104,6 +109,11 @@ name = get_phi_fv3_init type = scheme +######################################################################## +[ccpp-scheme-properties] + name = get_phi_fv3 + type = properties + ######################################################################## [ccpp-arg-table] name = get_phi_fv3_run diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 3d202722b..89e2e3fe4 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = gfdl_cloud_microphys + type = properties + +######################################################################## [ccpp-arg-table] name = gfdl_cloud_microphys_init type = scheme diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta index 18b37a3c5..181fbbe09 100644 --- a/physics/gfdl_fv_sat_adj.meta +++ b/physics/gfdl_fv_sat_adj.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = fv_sat_adj + type = properties + +######################################################################## [ccpp-arg-table] name = fv_sat_adj_init type = scheme diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index 6424789bc..c480d96c9 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = gmtb_scm_sfc_flux_spec + type = properties + +######################################################################## [ccpp-arg-table] name = gmtb_scm_sfc_flux_spec_run type = scheme diff --git a/physics/gscond.meta b/physics/gscond.meta index 57156358f..2fc1c96b9 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = zhaocarr_gscond + type = properties + +######################################################################## [ccpp-arg-table] name = zhaocarr_gscond_run type = scheme diff --git a/physics/gwdc.meta b/physics/gwdc.meta index b9f0b669c..58adc665f 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = gwdc_pre + type = properties + +######################################################################## [ccpp-arg-table] name = gwdc_pre_init type = scheme @@ -168,6 +173,11 @@ name = gwdc_pre_finalize type = scheme +######################################################################## +[ccpp-scheme-properties] + name = gwdc + type = properties + ######################################################################## [ccpp-arg-table] name = gwdc_init @@ -453,6 +463,11 @@ name = gwdc_finalize type = scheme +######################################################################## +[ccpp-scheme-properties] + name = gwdc_post + type = properties + ######################################################################## [ccpp-arg-table] name = gwdc_post_init diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 655c085ac..f22c9e3c4 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = gwdps + type = properties + +######################################################################## [ccpp-arg-table] name = gwdps_init type = scheme diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 995e25436..aef950e43 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = h2ophys + type = properties + +######################################################################## [ccpp-arg-table] name = h2ophys_init type = scheme diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta index bc3618703..b7690964a 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = lsm_ruc_sfc_sice_pre + type = properties + +######################################################################## [ccpp-arg-table] name = lsm_ruc_sfc_sice_pre_run type = scheme @@ -94,6 +99,11 @@ intent = out optional = F +######################################################################## +[ccpp-scheme-properties] + name = lsm_ruc_sfc_sice_post + type = properties + ######################################################################## [ccpp-arg-table] name = lsm_ruc_sfc_sice_post_run diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 00b0b39f3..b11d84b63 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = m_micro + type = properties + +######################################################################## [ccpp-arg-table] name = m_micro_init type = scheme diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 24fccdef0..762d0c6a4 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = m_micro_pre + type = properties + +######################################################################## [ccpp-arg-table] name = m_micro_pre_init type = scheme @@ -293,6 +298,11 @@ name = m_micro_pre_finalize type = scheme +######################################################################## +[ccpp-scheme-properties] + name = m_micro_post + type = properties + ######################################################################## [ccpp-arg-table] name = m_micro_post_init diff --git a/physics/machine.meta b/physics/machine.meta index d93f50e09..aba9f5ec3 100644 --- a/physics/machine.meta +++ b/physics/machine.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = machine + type = properties + +######################################################################## [ccpp-arg-table] name = machine type = module diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index 5146ce2f0..7c3e85fa4 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = maximum_hourly_diagnostics + type = properties + +######################################################################## [ccpp-arg-table] name = maximum_hourly_diagnostics_run type = scheme diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index fa1fe17c4..205ceef29 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = myjpbl_wrapper + type = properties + +######################################################################## [ccpp-arg-table] name = myjpbl_wrapper_run type = scheme diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index c26728f0f..76b8d9ec1 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = myjsfc_wrapper + type = properties + +######################################################################## [ccpp-arg-table] name = myjsfc_wrapper_run type = scheme diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 43f14ad5f..05ae2091c 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = mynnedmf_wrapper + type = properties + +######################################################################## [ccpp-arg-table] name = mynnedmf_wrapper_init type = scheme diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 655c65769..91b882178 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = mynnsfc_wrapper + type = properties + +######################################################################## [ccpp-arg-table] name = mynnsfc_wrapper_run type = scheme diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index da4191aad..3562e9fdf 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sgscloud_radpost + type = properties + +######################################################################## [ccpp-arg-table] name = sgscloud_radpost_run type = scheme diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 2658e8638..f57926a25 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sgscloud_radpre + type = properties + +######################################################################## [ccpp-arg-table] name = sgscloud_radpre_init type = scheme diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 196862ae6..4ff5826db 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = hedmf + type = properties + +######################################################################## [ccpp-arg-table] name = hedmf_init type = scheme diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index 2883e6847..a5203e802 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = hedmf_hafs + type = properties + +######################################################################## [ccpp-arg-table] name = hedmf_hafs_init type = scheme diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index e8da8478d..9ba2a4bd3 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = moninshoc + type = properties + +######################################################################## [ccpp-arg-table] name = moninshoc_run type = scheme diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index a7a33378a..aabfc5859 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = mp_fer_hires + type = properties + +######################################################################## [ccpp-arg-table] name = mp_fer_hires_init type = scheme diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index eeaeeb65d..479018908 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = mp_thompson_post + type = properties + +######################################################################## [ccpp-arg-table] name = mp_thompson_post_init type = scheme diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index d0b7809f0..70e2ec08e 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -1,7 +1,8 @@ [ccpp-scheme-properties] - name = mp_thompson + name = mp_thompson_pre type = properties +######################################################################## [ccpp-arg-table] name = mp_thompson_pre_run type = scheme diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 4f0e6aa9d..a7cbf9512 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = ozphys + type = properties + +######################################################################## [ccpp-arg-table] name = ozphys_init type = scheme diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index bfc010358..c5fb94602 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = ozphys_2015 + type = properties + +######################################################################## [ccpp-arg-table] name = ozphys_2015_init type = scheme diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 48c189c07..6d34d43ef 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = phys_tend + type = properties + +######################################################################## [ccpp-arg-table] name = phys_tend_run type = scheme diff --git a/physics/precpd.meta b/physics/precpd.meta index 6df3f35af..a7419d69f 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = zhaocarr_precpd + type = properties + +######################################################################## [ccpp-arg-table] name = zhaocarr_precpd_init type = scheme diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index e91fc10df..f2a050ae7 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_lw + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_lw_run type = scheme diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c8074cf47..17179ec07 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_sw + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_sw_run type = scheme diff --git a/physics/rascnv.meta b/physics/rascnv.meta index f83699347..aef381332 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rascnv + type = properties + +######################################################################## [ccpp-arg-table] name = rascnv_init type = scheme diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 554ac4139..49248e35e 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rayleigh_damp + type = properties + +######################################################################## [ccpp-arg-table] name = rayleigh_damp_init type = scheme diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 8bca0597e..9f86f1833 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_lw_post + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_lw_post_init type = scheme diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 6b4488b26..70e1b6184 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_lw_pre + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_lw_pre_init type = scheme diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 6ed13e830..599ab19c0 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_sw_post + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_sw_post_init type = scheme diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 6a68a8cd6..2612dc322 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmg_sw_pre + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmg_sw_pre_init type = scheme diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index c71a2a97e..4ac39957a 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_aerosol_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_aerosol_optics_run type = scheme diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 9de19382a..e15c0ce37 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_cloud_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_init type = scheme diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 87e785a4d..264f7bc5a 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_cloud_sampling + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_cloud_sampling_init type = scheme diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 36b8067dd..caccfd783 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_gas_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init type = scheme diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index f49563a49..5e3bacce3 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_pre + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_pre_run type = scheme diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index a8426bc15..dd2c34caa 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_lw_rte + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_lw_rte_run type = scheme diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index bd02434b6..4dbf6275d 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_sw_aerosol_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_sw_aerosol_optics_run type = scheme diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index c60ae90d6..c57982be3 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_sw_cloud_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_init type = scheme diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index c30d4934d..39619eccc 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_sw_cloud_sampling + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_sw_cloud_sampling_init type = scheme diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index fc8e72a9a..019fd4b11 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_sw_gas_optics + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init type = scheme diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 629ede530..83130acf8 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = rrtmgp_sw_rte + type = properties + +######################################################################## [ccpp-arg-table] name = rrtmgp_sw_rte_run type = scheme diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 9de8036d9..0f17d439b 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = samfdeepcnv + type = properties + +######################################################################## [ccpp-arg-table] name = samfdeepcnv_init type = scheme diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 09150adb4..58e28a20b 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = samfshalcnv + type = properties + +######################################################################## [ccpp-arg-table] name = samfshalcnv_init type = scheme diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 2e386bc43..3f543cd86 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sascnvn + type = properties + +######################################################################## [ccpp-arg-table] name = sascnvn_init type = scheme diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index c4230b950..84530f013 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = satmedmfvdif + type = properties + +######################################################################## [ccpp-arg-table] name = satmedmfvdif_init type = scheme diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 397d71537..14b10f410 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = satmedmfvdifq + type = properties + +######################################################################## [ccpp-arg-table] name = satmedmfvdifq_init type = scheme diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index a1c57d4d9..d8905bccc 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_cice + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_cice_run type = scheme diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index 0e9699faf..a98d45600 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_diag + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_diag_run type = scheme diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index 6c863a6af..61be91b27 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_diag_post + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_diag_post_run type = scheme diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index ab99dcb06..6c1285fc5 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_diff + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_diff_run type = scheme diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 7728ee375..03e402e99 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = lsm_noah + type = properties + +######################################################################## [ccpp-arg-table] name = lsm_noah_init type = scheme diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 4721418d3..d1355862d 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = lsm_ruc + type = properties + +######################################################################## [ccpp-arg-table] name = lsm_ruc_init type = scheme diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 4e1c5b334..bd927d1df 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = noahmpdrv + type = properties + +######################################################################## [ccpp-arg-table] name = noahmpdrv_init type = scheme diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 4198af0eb..31fddf45a 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -1,11 +1,6 @@ -[ccpp-arg-table] - name = sfc_nst_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sfc_nst_finalize - type = scheme +[ccpp-scheme-properties] + name = sfc_nst + type = properties ######################################################################## [ccpp-arg-table] @@ -650,14 +645,9 @@ optional = F ######################################################################## -[ccpp-arg-table] - name = sfc_nst_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sfc_nst_finalize - type = scheme +[ccpp-scheme-properties] + name = sfc_nst_pre + type = properties ######################################################################## [ccpp-arg-table] @@ -787,14 +777,9 @@ optional = F ######################################################################## -[ccpp-arg-table] - name = sfc_nst_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sfc_nst_post_finalize - type = scheme +[ccpp-scheme-properties] + name = sfc_nst_post + type = properties ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 733e69f54..588bb4848 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_ocean + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_ocean_init type = scheme diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index f916d09fd..f327f0f98 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = sfc_sice + type = properties + +######################################################################## [ccpp-arg-table] name = sfc_sice_run type = scheme diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index d56e1da3b..1c5266b8e 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = shalcnv + type = properties + +######################################################################## [ccpp-arg-table] name = shalcnv_init type = scheme diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 08646d7b9..d65727080 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = shinhongvdif + type = properties + +######################################################################## [ccpp-arg-table] name = shinhongvdif_run type = scheme diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index c040233a7..aa83b4c1f 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -1,3 +1,8 @@ +[ccpp-scheme-properties] + name = ysuvdif + type = properties + +######################################################################## [ccpp-arg-table] name = ysuvdif_run type = scheme From 1695333dc3a2b4ca3d0db7a5d285590ef172433c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 4 Aug 2020 16:05:02 -0600 Subject: [PATCH 42/97] Remove empty argument tables from all metadata files --- physics/GFS_GWD_generic.meta | 5 ----- physics/GFS_MP_generic.meta | 19 ------------------ physics/GFS_rad_time_vary.fv3.meta | 9 --------- physics/GFS_rad_time_vary.scm.meta | 9 --------- physics/GFS_rrtmg_post.meta | 9 --------- physics/GFS_rrtmg_pre.meta | 9 --------- physics/GFS_rrtmgp_pre.meta | 4 ---- physics/GFS_rrtmgp_sw_pre.meta | 4 ---- physics/cires_ugwp_post.meta | 9 --------- physics/cnvc90.meta | 9 --------- physics/cs_conv.meta | 30 ----------------------------- physics/cu_gf_driver.meta | 5 ----- physics/cu_ntiedtke.meta | 5 ----- physics/dcyc2.meta | 10 ---------- physics/drag_suite.meta | 9 --------- physics/get_prs_fv3.meta | 19 ------------------ physics/gwdc.meta | 29 ---------------------------- physics/gwdps.meta | 9 --------- physics/h2ophys.meta | 9 --------- physics/m_micro.meta | 5 ----- physics/m_micro_interstitial.meta | 19 ------------------ physics/module_SGSCloud_RadPre.meta | 10 ---------- physics/mp_fer_hires.meta | 4 ---- physics/ozphys.meta | 5 ----- physics/ozphys_2015.meta | 5 ----- physics/precpd.meta | 9 --------- physics/rayleigh_damp.meta | 9 --------- physics/rrtmg_lw_post.meta | 9 --------- physics/rrtmg_lw_pre.meta | 9 --------- physics/rrtmg_sw_post.meta | 9 --------- physics/rrtmg_sw_pre.meta | 9 --------- physics/rrtmgp_lw_cloud_optics.meta | 4 ---- physics/samfdeepcnv.meta | 10 ---------- physics/samfshalcnv.meta | 10 ---------- physics/sascnvn.meta | 5 ----- physics/sfc_ocean.meta | 10 ---------- physics/shalcnv.meta | 5 ----- 37 files changed, 357 deletions(-) diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 0b80ee934..7de421030 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -2,11 +2,6 @@ name = GFS_GWD_generic_pre type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_GWD_generic_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_GWD_generic_pre_run diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 125006cc0..c773aa216 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -2,11 +2,6 @@ name = GFS_MP_generic_pre type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_MP_generic_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_MP_generic_pre_run @@ -138,21 +133,11 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_MP_generic_pre_finalize - type = scheme - ######################################################################## [ccpp-scheme-properties] name = GFS_MP_generic_post type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_MP_generic_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_MP_generic_post_run @@ -934,7 +919,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_MP_generic_post_finalize - type = scheme diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index 46c536615..ea73cb813 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -2,11 +2,6 @@ name = GFS_rad_time_vary type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_rad_time_vary_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_rad_time_vary_run @@ -53,7 +48,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rad_time_vary_finalize - type = scheme diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 3a68ba163..74da3417d 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -2,11 +2,6 @@ name = GFS_rad_time_vary type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_rad_time_vary_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_rad_time_vary_run @@ -53,7 +48,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rad_time_vary_finalize - type = scheme diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index feb0f37c3..f72b9663b 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -2,11 +2,6 @@ name = GFS_rrtmg_post type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmg_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_rrtmg_post_run @@ -211,7 +206,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmg_post_finalize - type = scheme diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 04607f64b..98cff1199 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -2,11 +2,6 @@ name = GFS_rrtmg_pre type = properties -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmg_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = GFS_rrtmg_pre_run @@ -586,7 +581,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmg_pre_finalize - type = scheme diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 92ac1c357..17a2cef7e 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -366,7 +366,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_pre_finalize - type = scheme diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index e0da4948e..79a9c7fe8 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -193,7 +193,3 @@ type = integer intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_sw_pre_finalize - type = scheme diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 2ba9732d4..8dd695553 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -2,11 +2,6 @@ name = cires_ugwp_post type = properties -######################################################################## -[ccpp-arg-table] - name = cires_ugwp_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = cires_ugwp_post_run @@ -314,7 +309,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = cires_ugwp_post_finalize - type = scheme diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index caab909e3..d98d15b73 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -2,11 +2,6 @@ name = cnvc90 type = properties -######################################################################## -[ccpp-arg-table] - name = cnvc90_init - type = scheme - ######################################################################## [ccpp-arg-table] name = cnvc90_run @@ -142,7 +137,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = cnvc90_finalize - type = scheme diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index 9a1eba7a8..5a5f6a124 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -2,16 +2,6 @@ name = cs_conv_pre type = properties -######################################################################## -[ccpp-arg-table] - name = cs_conv_pre_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = cs_conv_pre_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = cs_conv_pre_run @@ -188,16 +178,6 @@ name = cs_conv_post type = properties -######################################################################## -[ccpp-arg-table] - name = cs_conv_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = cs_conv_post_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = cs_conv_post_run @@ -267,16 +247,6 @@ name = cs_conv type = properties -######################################################################## -[ccpp-arg-table] - name = cs_conv_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = cs_conv_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = cs_conv_run diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index f4ea2ea64..6ff5115c7 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -40,11 +40,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = cu_gf_driver_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = cu_gf_driver_run diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 17290da5f..1e5b1017b 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -40,11 +40,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = cu_ntiedtke_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = cu_ntiedtke_run diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 4bca64f1f..0be613381 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -2,16 +2,6 @@ name = dcyc2t3 type = properties -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = dcyc2t3_run diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index 49dea9339..88088fa33 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -2,11 +2,6 @@ name = drag_suite type = properties -######################################################################## -[ccpp-arg-table] - name = drag_suite_init - type = scheme - ######################################################################## [ccpp-arg-table] name = drag_suite_run @@ -613,7 +608,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = drag_suite_finalize - type = scheme diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta index d1323f182..0a9d1e5fd 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/get_prs_fv3.meta @@ -2,11 +2,6 @@ name = get_prs_fv3 type = properties -######################################################################## -[ccpp-arg-table] - name = get_prs_fv3_init - type = scheme - ######################################################################## [ccpp-arg-table] name = get_prs_fv3_run @@ -99,16 +94,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = get_prs_fv3_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = get_phi_fv3_init - type = scheme - ######################################################################## [ccpp-scheme-properties] name = get_phi_fv3 @@ -197,7 +182,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = get_phi_fv3_finalize - type = scheme diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 58adc665f..8c5be8bb1 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -2,11 +2,6 @@ name = gwdc_pre type = properties -######################################################################## -[ccpp-arg-table] - name = gwdc_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = gwdc_pre_run @@ -168,21 +163,11 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = gwdc_pre_finalize - type = scheme - ######################################################################## [ccpp-scheme-properties] name = gwdc type = properties -######################################################################## -[ccpp-arg-table] - name = gwdc_init - type = scheme - ######################################################################## [ccpp-arg-table] name = gwdc_run @@ -458,21 +443,11 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = gwdc_finalize - type = scheme - ######################################################################## [ccpp-scheme-properties] name = gwdc_post type = properties -######################################################################## -[ccpp-arg-table] - name = gwdc_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = gwdc_post_run @@ -653,7 +628,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = gwdc_post_finalize - type = scheme diff --git a/physics/gwdps.meta b/physics/gwdps.meta index f22c9e3c4..052ed3623 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -2,11 +2,6 @@ name = gwdps type = properties -######################################################################## -[ccpp-arg-table] - name = gwdps_init - type = scheme - ######################################################################## [ccpp-arg-table] name = gwdps_run @@ -371,7 +366,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = gwdps_finalize - type = scheme diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index aef950e43..d680386a7 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -2,11 +2,6 @@ name = h2ophys type = properties -######################################################################## -[ccpp-arg-table] - name = h2ophys_init - type = scheme - ######################################################################## [ccpp-arg-table] name = h2ophys_run @@ -122,7 +117,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = h2ophys_finalize - type = scheme diff --git a/physics/m_micro.meta b/physics/m_micro.meta index b11d84b63..8ac70f39d 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -297,11 +297,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = m_micro_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = m_micro_run diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 762d0c6a4..09b208448 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -2,11 +2,6 @@ name = m_micro_pre type = properties -######################################################################## -[ccpp-arg-table] - name = m_micro_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = m_micro_pre_run @@ -293,21 +288,11 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = m_micro_pre_finalize - type = scheme - ######################################################################## [ccpp-scheme-properties] name = m_micro_post type = properties -######################################################################## -[ccpp-arg-table] - name = m_micro_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = m_micro_post_run @@ -515,7 +500,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = m_micro_post_finalize - type = scheme diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index f57926a25..5e956fc37 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -2,16 +2,6 @@ name = sgscloud_radpre type = properties -######################################################################## -[ccpp-arg-table] - name = sgscloud_radpre_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sgscloud_radpre_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = sgscloud_radpre_run diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index aabfc5859..4e6a42d92 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -132,10 +132,6 @@ intent = out optional = F ######################################################################## -[ccpp-arg-table] - name = mp_fer_hires_finalize - type = scheme -######################################################################## [ccpp-arg-table] name = mp_fer_hires_run type = scheme diff --git a/physics/ozphys.meta b/physics/ozphys.meta index a7cbf9512..218ef4655 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -32,11 +32,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = ozphys_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = ozphys_run diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index c5fb94602..b90b76adc 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -32,11 +32,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = ozphys_2015_run diff --git a/physics/precpd.meta b/physics/precpd.meta index a7419d69f..921bfd1d6 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -2,11 +2,6 @@ name = zhaocarr_precpd type = properties -######################################################################## -[ccpp-arg-table] - name = zhaocarr_precpd_init - type = scheme - ######################################################################## [ccpp-arg-table] name = zhaocarr_precpd_run @@ -196,7 +191,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = zhaocarr_precpd_finalize - type = scheme diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 49248e35e..1cce87f67 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -2,11 +2,6 @@ name = rayleigh_damp type = properties -######################################################################## -[ccpp-arg-table] - name = rayleigh_damp_init - type = scheme - ######################################################################## [ccpp-arg-table] name = rayleigh_damp_run @@ -195,7 +190,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rayleigh_damp_finalize - type = scheme diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 9f86f1833..35c162176 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -2,11 +2,6 @@ name = rrtmg_lw_post type = properties -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = rrtmg_lw_post_run @@ -120,7 +115,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_post_finalize - type = scheme diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 70e1b6184..197eb1865 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -2,11 +2,6 @@ name = rrtmg_lw_pre type = properties -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = rrtmg_lw_pre_run @@ -87,7 +82,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_pre_finalize - type = scheme diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 599ab19c0..e31943267 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -2,11 +2,6 @@ name = rrtmg_sw_post type = properties -######################################################################## -[ccpp-arg-table] - name = rrtmg_sw_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = rrtmg_sw_post_run @@ -171,7 +166,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rrtmg_sw_post_finalize - type = scheme diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 2612dc322..cf4fb9769 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -2,11 +2,6 @@ name = rrtmg_sw_pre type = properties -######################################################################## -[ccpp-arg-table] - name = rrtmg_sw_pre_init - type = scheme - ######################################################################## [ccpp-arg-table] name = rrtmg_sw_pre_run @@ -148,7 +143,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rrtmg_sw_pre_finalize - type = scheme diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index e15c0ce37..e26009ced 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -284,7 +284,3 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_cloud_optics_finalize - type = scheme diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 0f17d439b..5131ac211 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -2,16 +2,6 @@ name = samfdeepcnv type = properties -######################################################################## -[ccpp-arg-table] - name = samfdeepcnv_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = samfdeepcnv_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = samfdeepcnv_run diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 58e28a20b..c7138862a 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -2,16 +2,6 @@ name = samfshalcnv type = properties -######################################################################## -[ccpp-arg-table] - name = samfshalcnv_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = samfshalcnv_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = samfshalcnv_run diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 3f543cd86..32d37740a 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -40,11 +40,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = sascnvn_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = sascnvn_run diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 588bb4848..39f59c5c0 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -2,16 +2,6 @@ name = sfc_ocean type = properties -######################################################################## -[ccpp-arg-table] - name = sfc_ocean_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sfc_ocean_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = sfc_ocean_run diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index 1c5266b8e..1197a04ad 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -56,11 +56,6 @@ intent = out optional = F -######################################################################## -[ccpp-arg-table] - name = shalcnv_finalize - type = scheme - ######################################################################## [ccpp-arg-table] name = shalcnv_run From 17a94800053f3b3f06fc59966cb95439eba4b5f1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 4 Aug 2020 16:08:05 -0600 Subject: [PATCH 43/97] Remove executable flag from cires_ugwp_post.F90, module_BL_MYJPBL.F90, module_SF_JSFC.F90 --- physics/cires_ugwp_post.F90 | 0 physics/module_BL_MYJPBL.F90 | 0 physics/module_SF_JSFC.F90 | 0 3 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 physics/cires_ugwp_post.F90 mode change 100755 => 100644 physics/module_BL_MYJPBL.F90 mode change 100755 => 100644 physics/module_SF_JSFC.F90 diff --git a/physics/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 old mode 100755 new mode 100644 diff --git a/physics/module_BL_MYJPBL.F90 b/physics/module_BL_MYJPBL.F90 old mode 100755 new mode 100644 diff --git a/physics/module_SF_JSFC.F90 b/physics/module_SF_JSFC.F90 old mode 100755 new mode 100644 From 7469ff4e7ba6581758c678fe65ee3d6ef1118c35 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 5 Aug 2020 14:07:54 -0600 Subject: [PATCH 44/97] Add dependencies to all metadata files --- physics/GFS_DCNV_generic.meta | 2 ++ physics/GFS_GWD_generic.meta | 2 ++ physics/GFS_MP_generic.meta | 2 ++ physics/GFS_PBL_generic.meta | 2 ++ physics/GFS_SCNV_generic.meta | 2 ++ physics/GFS_debug.meta | 4 ++++ physics/GFS_phys_time_vary.fv3.meta | 1 + physics/GFS_phys_time_vary.scm.meta | 1 + physics/GFS_rad_time_vary.fv3.meta | 1 + physics/GFS_rad_time_vary.scm.meta | 1 + physics/GFS_rrtmg_post.meta | 1 + physics/GFS_rrtmg_pre.meta | 1 + physics/GFS_rrtmg_setup.meta | 1 + physics/GFS_rrtmgp_lw_post.meta | 1 + physics/GFS_rrtmgp_pre.meta | 1 + physics/GFS_rrtmgp_setup.meta | 1 + physics/GFS_rrtmgp_sw_post.meta | 1 + physics/GFS_rrtmgp_sw_pre.meta | 1 + physics/GFS_stochastics.meta | 1 + physics/GFS_suite_interstitial.meta | 9 +++++++++ physics/GFS_surface_composites.meta | 3 +++ physics/GFS_surface_generic.meta | 2 ++ physics/GFS_surface_loop_control.meta | 2 ++ physics/GFS_time_vary_pre.fv3.meta | 1 + physics/GFS_time_vary_pre.scm.meta | 1 + physics/cires_ugwp.meta | 2 +- physics/cires_ugwp_post.meta | 1 + physics/cnvc90.meta | 1 + physics/cs_conv.meta | 3 +++ physics/cs_conv_aw_adj.meta | 1 + physics/cu_gf_driver.meta | 1 + physics/cu_gf_driver_post.meta | 1 + physics/cu_gf_driver_pre.meta | 1 + physics/cu_ntiedtke.meta | 1 + physics/cu_ntiedtke_post.meta | 1 + physics/cu_ntiedtke_pre.meta | 1 + physics/dcyc2.meta | 1 + physics/drag_suite.meta | 1 + physics/flake_driver.meta | 1 + physics/gcm_shoc.meta | 1 + physics/get_prs_fv3.meta | 2 ++ physics/gfdl_cloud_microphys.meta | 1 + physics/gfdl_fv_sat_adj.meta | 1 + physics/gmtb_scm_sfc_flux_spec.meta | 1 + physics/gscond.meta | 1 + physics/gwdc.meta | 3 +++ physics/gwdps.meta | 1 + physics/h2ophys.meta | 1 + physics/lsm_ruc_sfc_sice_interstitial.meta | 2 ++ physics/m_micro.meta | 1 + physics/m_micro_interstitial.meta | 2 ++ physics/machine.meta | 1 + physics/maximum_hourly_diagnostics.meta | 1 + physics/module_MYJPBL_wrapper.meta | 1 + physics/module_MYJSFC_wrapper.meta | 1 + physics/module_MYNNPBL_wrapper.meta | 1 + physics/module_MYNNSFC_wrapper.meta | 1 + physics/module_SGSCloud_RadPost.meta | 1 + physics/module_SGSCloud_RadPre.meta | 1 + physics/moninedmf.meta | 1 + physics/moninedmf_hafs.meta | 1 + physics/moninshoc.meta | 1 + physics/mp_fer_hires.meta | 1 + physics/mp_thompson.meta | 2 +- physics/mp_thompson_post.meta | 1 + physics/mp_thompson_pre.meta | 1 + physics/ozphys.meta | 1 + physics/ozphys_2015.meta | 1 + physics/phys_tend.meta | 1 + physics/precpd.meta | 1 + physics/radlw_main.meta | 1 + physics/radsw_main.meta | 1 + physics/rascnv.meta | 1 + physics/rayleigh_damp.meta | 1 + physics/rrtmg_lw_post.meta | 1 + physics/rrtmg_lw_pre.meta | 1 + physics/rrtmg_sw_post.meta | 1 + physics/rrtmg_sw_pre.meta | 1 + physics/rrtmgp_lw_aerosol_optics.meta | 1 + physics/rrtmgp_lw_cloud_optics.meta | 1 + physics/rrtmgp_lw_cloud_sampling.meta | 1 + physics/rrtmgp_lw_gas_optics.meta | 1 + physics/rrtmgp_lw_pre.meta | 1 + physics/rrtmgp_lw_rte.meta | 1 + physics/rrtmgp_sw_aerosol_optics.meta | 1 + physics/rrtmgp_sw_cloud_optics.meta | 1 + physics/rrtmgp_sw_cloud_sampling.meta | 1 + physics/rrtmgp_sw_gas_optics.meta | 1 + physics/rrtmgp_sw_rte.meta | 1 + physics/samfdeepcnv.meta | 1 + physics/samfshalcnv.meta | 1 + physics/sascnvn.meta | 1 + physics/satmedmfvdif.meta | 1 + physics/satmedmfvdifq.meta | 1 + physics/sfc_cice.meta | 1 + physics/sfc_diag.meta | 1 + physics/sfc_diag_post.meta | 1 + physics/sfc_diff.meta | 1 + physics/sfc_drv.meta | 1 + physics/sfc_drv_ruc.meta | 1 + physics/sfc_noahmp_drv.meta | 1 + physics/sfc_nst.meta | 3 +++ physics/sfc_ocean.meta | 1 + physics/sfc_sice.meta | 1 + physics/shalcnv.meta | 1 + physics/shinhongvdif.meta | 1 + physics/ysuvdif.meta | 1 + 107 files changed, 136 insertions(+), 2 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 6d04019bc..e1156c7fe 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_DCNV_generic_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -157,6 +158,7 @@ [ccpp-scheme-properties] name = GFS_DCNV_generic_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 7de421030..763e848dc 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_GWD_generic_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -247,6 +248,7 @@ [ccpp-scheme-properties] name = GFS_GWD_generic_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index c773aa216..5f79092fb 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_MP_generic_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -137,6 +138,7 @@ [ccpp-scheme-properties] name = GFS_MP_generic_post type = properties + dependencies = calpreciptype.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index aa1bedd1c..7049e8e85 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_PBL_generic_pre type = properties + dependencies = GFS_PBL_generic.F90,machine.F ######################################################################## [ccpp-arg-table] @@ -421,6 +422,7 @@ [ccpp-scheme-properties] name = GFS_PBL_generic_post type = properties + dependencies = GFS_PBL_generic.F90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 16e30d224..da8388ae7 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_SCNV_generic_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -140,6 +141,7 @@ [ccpp-scheme-properties] name = GFS_SCNV_generic_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index 5c0c9972a..6aca658e3 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_diagtoscreen type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -132,6 +133,7 @@ [ccpp-scheme-properties] name = GFS_interstitialtoscreen type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -263,6 +265,7 @@ [ccpp-scheme-properties] name = GFS_abort type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -306,6 +309,7 @@ [ccpp-scheme-properties] name = GFS_checkland type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index fdf8e6e3e..f9c13df40 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_phys_time_vary type = properties + dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,num_parthds.F,ozinterp.f90,ozne_def.f,sfcsub.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 5087c77dd..3de1febd0 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_phys_time_vary type = properties + dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index ea73cb813..18e9eed75 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rad_time_vary type = properties + dependencies = machine.F,mersenne_twister.f,physparam.f,radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 74da3417d..8b8a6b878 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rad_time_vary type = properties + dependencies = machine.F,mersenne_twister.f,physparam.f,radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index f72b9663b..04febd5d7 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmg_post type = properties + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 98cff1199..cd2e9bbb0 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmg_pre type = properties + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index dd078dd4d..408b41bf8 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmg_setup type = properties + dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,radlw_main.f,radlw_param.f,radsw_main.f,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 15be791ab..d4fcf6547 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmgp_lw_post type = properties + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rrtmgp_aux.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 17a2cef7e..173f7c4e8 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmgp_pre type = properties + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,rrtmg_lw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 876490038..412094787 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmgp_setup type = properties + dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index b01f3fc3d..9f905cca3 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmgp_sw_post type = properties + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rrtmgp_aux.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 79a9c7fe8..2851e0d80 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmgp_sw_pre type = properties + dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f,radiation_surface.f,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index d1e7fa973..9effaabf2 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_stochastics type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 4ec6e43ff..24ed8f774 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_rad_reset type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -44,6 +45,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_phys_reset type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -87,6 +89,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_1 type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -281,6 +284,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_2 type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -804,6 +808,7 @@ [ccpp-scheme-properties] name = GFS_suite_stateout_reset type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -927,6 +932,7 @@ [ccpp-scheme-properties] name = GFS_suite_stateout_update type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -1095,6 +1101,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_3 type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -1532,6 +1539,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_4 type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -1851,6 +1859,7 @@ [ccpp-scheme-properties] name = GFS_suite_interstitial_5 type = properties + dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index a09d38fe6..63184dca8 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_surface_composites_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -646,6 +647,7 @@ [ccpp-scheme-properties] name = GFS_surface_composites_inter type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -795,6 +797,7 @@ [ccpp-scheme-properties] name = GFS_surface_composites_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 3cd011f97..d1d9143b5 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_surface_generic_pre type = properties + dependencies = machine.F,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] @@ -508,6 +509,7 @@ [ccpp-scheme-properties] name = GFS_surface_generic_post type = properties + dependencies = machine.F,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta index 52fa7616e..16af00db3 100644 --- a/physics/GFS_surface_loop_control.meta +++ b/physics/GFS_surface_loop_control.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_surface_loop_control_part1 type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -61,6 +62,7 @@ [ccpp-scheme-properties] name = GFS_surface_loop_control_part2 type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index 0f92e7dae..d38922c6d 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_time_vary_pre type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 2c50b215e..6b84da68c 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = GFS_time_vary_pre type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 03c8b9f32..377620c6a 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -2,7 +2,7 @@ name = cires_ugwp type = properties # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp! - dependencies = gwdps.f + dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90,cires_ugwp_solvers.F90,cires_ugwp_utils.F90,cires_orowam2017.f,cires_vert_lsatdis.F90,cires_vert_orodis.F90,cires_vert_wmsdis.F90,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 8dd695553..0791d6d9f 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cires_ugwp_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index d98d15b73..71ba19c35 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cnvc90 type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index 5a5f6a124..28fd28fd2 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cs_conv_pre type = properties + dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] @@ -177,6 +178,7 @@ [ccpp-scheme-properties] name = cs_conv_post type = properties + dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] @@ -246,6 +248,7 @@ [ccpp-scheme-properties] name = cs_conv type = properties + dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_aw_adj.meta b/physics/cs_conv_aw_adj.meta index 29053478c..15142e121 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/cs_conv_aw_adj.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cs_conv_aw_adj type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 6ff5115c7..2f0c999cd 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_gf_driver type = properties + dependencies = cu_gf_deep.F90,cu_gf_sh.F90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 60faa7a54..8e85ab3a2 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_gf_driver_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 10995be4b..fa23bf960 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_gf_driver_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 1e5b1017b..331abfc14 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_ntiedtke type = properties + dependencies = machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_post.meta b/physics/cu_ntiedtke_post.meta index 241adefce..491febaeb 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/cu_ntiedtke_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_ntiedtke_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_pre.meta b/physics/cu_ntiedtke_pre.meta index ef154c218..b5892ce10 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/cu_ntiedtke_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = cu_ntiedtke_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 0be613381..e2264a2ff 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = dcyc2t3 type = properties + dependencies = machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index 88088fa33..d57f334f9 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = drag_suite type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 353d174c3..037e5b463 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = flake_driver type = properties + dependencies = flake.F90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 2068428fb..a53687eb7 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = shoc type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta index 0a9d1e5fd..2da5bbe11 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/get_prs_fv3.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = get_prs_fv3 type = properties + dependencies = machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] @@ -98,6 +99,7 @@ [ccpp-scheme-properties] name = get_phi_fv3 type = properties + dependencies = machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 89e2e3fe4..ef226dbbd 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = gfdl_cloud_microphys type = properties + dependencies = machine.F,module_mp_radar.F90,module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta index 181fbbe09..7369c34d3 100644 --- a/physics/gfdl_fv_sat_adj.meta +++ b/physics/gfdl_fv_sat_adj.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = fv_sat_adj type = properties + dependencies = machine.F,module_gfdl_cloud_microphys.F90,module_mp_radar.F90,multi_gases.F90,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index c480d96c9..e73deada0 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = gmtb_scm_sfc_flux_spec type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gscond.meta b/physics/gscond.meta index 2fc1c96b9..f8c524268 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = zhaocarr_gscond type = properties + dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 8c5be8bb1..e0310b4ee 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = gwdc_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -167,6 +168,7 @@ [ccpp-scheme-properties] name = gwdc type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -447,6 +449,7 @@ [ccpp-scheme-properties] name = gwdc_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 052ed3623..024c6781d 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = gwdps type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index d680386a7..40ed95848 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = h2ophys type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta index b7690964a..dc06c1a72 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = lsm_ruc_sfc_sice_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -103,6 +104,7 @@ [ccpp-scheme-properties] name = lsm_ruc_sfc_sice_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 8ac70f39d..80dcc4195 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = m_micro type = properties + dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 09b208448..591dcdc4c 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = m_micro_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] @@ -292,6 +293,7 @@ [ccpp-scheme-properties] name = m_micro_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/machine.meta b/physics/machine.meta index aba9f5ec3..92d09e629 100644 --- a/physics/machine.meta +++ b/physics/machine.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = machine type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index 7c3e85fa4..00a0bbd34 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = maximum_hourly_diagnostics type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 205ceef29..c396bc991 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = myjpbl_wrapper type = properties + dependencies = module_BL_MYJPBL.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index 76b8d9ec1..aab6a66e4 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = myjsfc_wrapper type = properties + dependencies = module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 05ae2091c..2ce69b270 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = mynnedmf_wrapper type = properties + dependencies = machine.F,module_bl_mynn.F90,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 91b882178..9b62aae52 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = mynnsfc_wrapper type = properties + dependencies = machine.F,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index 3562e9fdf..0f4041f10 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sgscloud_radpost type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 5e956fc37..87e77657f 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sgscloud_radpre type = properties + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f ######################################################################## [ccpp-arg-table] diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 4ff5826db..5a41ee2d0 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = hedmf type = properties + dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90,tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index a5203e802..26a4e4409 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = hedmf_hafs type = properties + dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 9ba2a4bd3..3b7a50ad5 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = moninshoc type = properties + dependencies = funcphys.f90,machine.F,tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 4e6a42d92..3c085600b 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = mp_fer_hires type = properties + dependencies = machine.F,module_MP_FER_HIRES.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 5e502441f..a4f369682 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,7 +1,7 @@ [ccpp-scheme-properties] name = mp_thompson type = properties - dependencies = module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = machine.F,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 479018908..9f6d3e3b6 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = mp_thompson_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index 70e2ec08e..f14340a03 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = mp_thompson_pre type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 218ef4655..f9c29bd11 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = ozphys type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index b90b76adc..1c2cf364f 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = ozphys_2015 type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 6d34d43ef..5362137a5 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = phys_tend type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/precpd.meta b/physics/precpd.meta index 921bfd1d6..1435ead20 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = zhaocarr_precpd type = properties + dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index f2a050ae7..00e390cb9 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_lw type = properties + dependencies = mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 17179ec07..679d3b8ca 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_sw type = properties + dependencies = mersenne_twister.f,physcons.F90,physparam.f,radsw_datatb.f,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rascnv.meta b/physics/rascnv.meta index aef381332..d92a6aadd 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rascnv type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 1cce87f67..d502e5bd1 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rayleigh_damp type = properties + dependencies = ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 35c162176..2b3c157a5 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_lw_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 197eb1865..2d6aa294f 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_lw_pre type = properties + dependencies = iounitdef.f,machine.F,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index e31943267..3ed4600fd 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_sw_post type = properties + dependencies = machine.F,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index cf4fb9769..55b365334 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmg_sw_pre type = properties + dependencies = iounitdef.f,machine.F,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 4ac39957a..5093d66cc 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_aerosol_optics type = properties + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index e26009ced..147cd7916 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_cloud_optics type = properties + dependencies = machine.F,rrtmg_lw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 264f7bc5a..1868c408d 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_cloud_sampling type = properties + dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index caccfd783..dddb93c4c 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_gas_optics type = properties + dependencies = machine.F,rrtmgp_aux.F90,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/mo_source_functions.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 5e3bacce3..c8f7adc76 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_pre type = properties + dependencies = iounitdef.f,machine.F,physparam.f,radiation_surface.f,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index dd2c34caa..d7488ca4c 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_lw_rte type = properties + dependencies = machine.F,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_source_functions.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 4dbf6275d..a87c9a756 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_sw_aerosol_optics type = properties + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index c57982be3..b9343a532 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_sw_cloud_optics type = properties + dependencies = machine.F,physparam.f,rrtmg_sw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 39619eccc..158cf7c07 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_sw_cloud_sampling type = properties + dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 019fd4b11..d2196736e 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_sw_gas_optics type = properties + dependencies = iounitdef.f,machine.F,radiation_gases.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 83130acf8..e03e6be40 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = rrtmgp_sw_rte type = properties + dependencies = machine.F,radsw_param.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/rte/mo_rte_sw.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 5131ac211..f852a5002 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = samfdeepcnv type = properties + dependencies = funcphys.f90,machine.F,samfaerosols.F ######################################################################## [ccpp-arg-table] diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index c7138862a..eb41f0ed5 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = samfshalcnv type = properties + dependencies = funcphys.f90,machine.F,samfaerosols.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 32d37740a..2d1a21233 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sascnvn type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 84530f013..97f146867 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = satmedmfvdif type = properties + dependencies = funcphys.f90,machine.F,mfpblt.f,mfscu.f,tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 14b10f410..a92f99a22 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = satmedmfvdifq type = properties + dependencies = funcphys.f90,machine.F,mfpbltq.f,mfscuq.f,tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index d8905bccc..5bce871cc 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_cice type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index a98d45600..cf77201d7 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_diag type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index 61be91b27..84c552f8a 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_diag_post type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 6c1285fc5..9ff0baaa7 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_diff type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 03e402e99..8801ff233 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = lsm_noah type = properties + dependencies = funcphys.f90,machine.F,set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index d1355862d..09f372c99 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = lsm_ruc type = properties + dependencies = machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index bd927d1df..e8787ede8 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = noahmpdrv type = properties + dependencies = funcphys.f90,machine.F,module_sf_noahmp_glacier.f90,module_sf_noahmplsm.f90,noahmp_tables.f90,set_soilveg.f ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 31fddf45a..09d2828a7 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_nst type = properties + dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] @@ -648,6 +649,7 @@ [ccpp-scheme-properties] name = sfc_nst_pre type = properties + dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] @@ -780,6 +782,7 @@ [ccpp-scheme-properties] name = sfc_nst_post type = properties + dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 39f59c5c0..6e7174d89 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_ocean type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index f327f0f98..ee17a4fc7 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = sfc_sice type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index 1197a04ad..15465a583 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = shalcnv type = properties + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index d65727080..aff7962a0 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = shinhongvdif type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index aa83b4c1f..d0092569f 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -1,6 +1,7 @@ [ccpp-scheme-properties] name = ysuvdif type = properties + dependencies = machine.F ######################################################################## [ccpp-arg-table] From b14f2d69113d46a84c67d0804c1ca68d9a8f702c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 5 Aug 2020 15:14:51 -0600 Subject: [PATCH 45/97] physics/mp_thompson.meta: add missing dependency on module_mp_radar.F90 --- physics/mp_thompson.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index a4f369682..01f38fa6a 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,7 +1,7 @@ [ccpp-scheme-properties] name = mp_thompson type = properties - dependencies = machine.F,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] From ba80a78582e37b4783c0358834c2fddeabc1d208 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 6 Aug 2020 07:38:46 -0600 Subject: [PATCH 46/97] physics/GFS_rrtmg_pre.meta: add missing dependency on module_mp_radar.F90 --- physics/GFS_rrtmg_pre.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index cd2e9bbb0..5afbdfe30 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1,7 +1,7 @@ [ccpp-scheme-properties] name = GFS_rrtmg_pre type = properties - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90 + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] From 4afa3027d3100ad7c26e5f6d9a1d6fe64f86d88c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 6 Aug 2020 07:39:20 -0600 Subject: [PATCH 47/97] CMakeLists.txt: check if file is in list of schemes before applying special optimization flags --- CMakeLists.txt | 55 +++++++++++++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 21 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5e0175d0c..06ca63d0b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -17,6 +17,11 @@ if(POLICY CMP0042) cmake_policy(SET CMP0042 NEW) endif(POLICY CMP0042) +# CMP0057: Support new IN_LIST if() operator +if(POLICY CMP0057) + cmake_policy(SET CMP0057 NEW) +endif(POLICY CMP0057) + #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") @@ -131,6 +136,7 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) if (DYN32) + if (${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 IN_LIST SCHEMES) # Reduce floating point precision from 64-bit to 32-bit, if necessary set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-fdefault-real-8" "" @@ -141,7 +147,8 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) - endif (DYN32) + endif() + endif() # Remove files with special floating point precision flags from list # of files with standard floating point precision flags flags @@ -179,26 +186,30 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") - # Reduce optimization for module_sf_mynn.F90 (to avoid an apparent compiler bug with Intel 18 on Hera) - SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 - PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT} -O1") - list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90) + if (${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 IN_LIST SCHEMES) + # Reduce optimization for module_sf_mynn.F90 (to avoid an apparent compiler bug with Intel 18 on Hera) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT} -O1") + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90) + endif() - # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files - set(CMAKE_Fortran_FLAGS_LOPT1 ${CMAKE_Fortran_FLAGS_OPT}) - string(REPLACE "-xHOST" "-xCORE-AVX-I" - CMAKE_Fortran_FLAGS_LOPT1 - "${CMAKE_Fortran_FLAGS_LOPT1}") - string(REPLACE "-xCORE-AVX2" "-xCORE-AVX-I" - CMAKE_Fortran_FLAGS_LOPT1 - "${CMAKE_Fortran_FLAGS_LOPT1}") - string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" - CMAKE_Fortran_FLAGS_LOPT1 - "${CMAKE_Fortran_FLAGS_LOPT1}") - SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f - PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT1}") - # Add all of the above files to the list of schemes with special compiler flags - list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f) + if (${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f IN_LIST SCHEMES) + # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files + set(CMAKE_Fortran_FLAGS_LOPT1 ${CMAKE_Fortran_FLAGS_OPT}) + string(REPLACE "-xHOST" "-xCORE-AVX-I" + CMAKE_Fortran_FLAGS_LOPT1 + "${CMAKE_Fortran_FLAGS_LOPT1}") + string(REPLACE "-xCORE-AVX2" "-xCORE-AVX-I" + CMAKE_Fortran_FLAGS_LOPT1 + "${CMAKE_Fortran_FLAGS_LOPT1}") + string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" + CMAKE_Fortran_FLAGS_LOPT1 + "${CMAKE_Fortran_FLAGS_LOPT1}") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f + PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT1}") + # Add all of the above files to the list of schemes with special compiler flags + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f) + endif() # Remove files with special compiler flags from list of files with standard compiler flags list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) @@ -209,6 +220,7 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) if (DYN32) + if (${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 IN_LIST SCHEMES) # Reduce floating point precision from 64-bit to 32-bit, if necessary set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-real-size 64" "-real-size 32" @@ -217,7 +229,8 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) - endif (DYN32) + endif() + endif() # Remove files with special floating point precision flags from list # of files with standard floating point precision flags flags From fc0144dca99e6ba3571d43084b97753c5e0f63c1 Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Thu, 6 Aug 2020 19:44:35 +0000 Subject: [PATCH 48/97] Added missing optional info, per Laurie Carson's request --- physics/GFS_surface_generic.meta | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index e8f09274a..7ab6c0000 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -275,6 +275,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = real kind = kind_phys + optional = F [lndp_var_list] standard_name = variables_to_be_perturbed_for_landperts long_name = variables to be perturbed for landperts @@ -282,6 +283,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = character kind = len=3 + optional = F [z01d] standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length From d793511bfffa8d37b7d095d411c0ab80354389d6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 7 Aug 2020 12:16:56 -0600 Subject: [PATCH 49/97] Add/update ccpp-table-properties section and complete dependencies --- physics/GFS_DCNV_generic.meta | 8 ++--- physics/GFS_GWD_generic.meta | 8 ++--- physics/GFS_MP_generic.meta | 8 ++--- physics/GFS_PBL_generic.meta | 8 ++--- physics/GFS_SCNV_generic.meta | 8 ++--- physics/GFS_debug.meta | 16 +++++----- physics/GFS_phys_time_vary.fv3.meta | 4 +-- physics/GFS_phys_time_vary.scm.meta | 4 +-- physics/GFS_rad_time_vary.fv3.meta | 4 +-- physics/GFS_rad_time_vary.scm.meta | 4 +-- physics/GFS_rrtmg_post.meta | 4 +-- physics/GFS_rrtmg_pre.meta | 4 +-- physics/GFS_rrtmg_setup.meta | 4 +-- physics/GFS_rrtmgp_lw_post.meta | 6 ++-- physics/GFS_rrtmgp_pre.meta | 7 +++-- physics/GFS_rrtmgp_setup.meta | 4 +-- physics/GFS_rrtmgp_sw_post.meta | 7 +++-- physics/GFS_rrtmgp_sw_pre.meta | 6 ++-- physics/GFS_stochastics.meta | 4 +-- physics/GFS_suite_interstitial.meta | 36 +++++++++++----------- physics/GFS_surface_composites.meta | 12 ++++---- physics/GFS_surface_generic.meta | 8 ++--- physics/GFS_surface_loop_control.meta | 8 ++--- physics/GFS_time_vary_pre.fv3.meta | 4 +-- physics/GFS_time_vary_pre.scm.meta | 4 +-- physics/cires_ugwp.meta | 4 +-- physics/cires_ugwp_post.meta | 4 +-- physics/cnvc90.meta | 4 +-- physics/cs_conv.meta | 12 ++++---- physics/cs_conv_aw_adj.meta | 4 +-- physics/cu_gf_driver.meta | 4 +-- physics/cu_gf_driver_post.meta | 4 +-- physics/cu_gf_driver_pre.meta | 4 +-- physics/cu_ntiedtke.meta | 4 +-- physics/cu_ntiedtke_post.meta | 4 +-- physics/cu_ntiedtke_pre.meta | 4 +-- physics/dcyc2.meta | 4 +-- physics/drag_suite.meta | 4 +-- physics/flake_driver.meta | 4 +-- physics/gcm_shoc.meta | 4 +-- physics/get_prs_fv3.meta | 8 ++--- physics/gfdl_cloud_microphys.meta | 4 +-- physics/gfdl_fv_sat_adj.meta | 4 +-- physics/gmtb_scm_sfc_flux_spec.meta | 4 +-- physics/gscond.meta | 4 +-- physics/gwdc.meta | 12 ++++---- physics/gwdps.meta | 4 +-- physics/h2ophys.meta | 4 +-- physics/lsm_ruc_sfc_sice_interstitial.meta | 8 ++--- physics/m_micro.meta | 4 +-- physics/m_micro_interstitial.meta | 8 ++--- physics/machine.meta | 4 +-- physics/maximum_hourly_diagnostics.meta | 4 +-- physics/module_MYJPBL_wrapper.meta | 4 +-- physics/module_MYJSFC_wrapper.meta | 4 +-- physics/module_MYNNPBL_wrapper.meta | 4 +-- physics/module_MYNNSFC_wrapper.meta | 4 +-- physics/module_SGSCloud_RadPost.meta | 4 +-- physics/module_SGSCloud_RadPre.meta | 4 +-- physics/moninedmf.meta | 4 +-- physics/moninedmf_hafs.meta | 4 +-- physics/moninshoc.meta | 4 +-- physics/mp_fer_hires.meta | 4 +-- physics/mp_thompson.meta | 4 +-- physics/mp_thompson_post.meta | 4 +-- physics/mp_thompson_pre.meta | 4 +-- physics/ozphys.meta | 4 +-- physics/ozphys_2015.meta | 4 +-- physics/phys_tend.meta | 4 +-- physics/precpd.meta | 4 +-- physics/radlw_main.meta | 4 +-- physics/radlw_param.meta | 15 +++++++++ physics/radsw_main.meta | 4 +-- physics/radsw_param.meta | 20 ++++++++++++ physics/rascnv.meta | 4 +-- physics/rayleigh_damp.meta | 4 +-- physics/rrtmg_lw_post.meta | 4 +-- physics/rrtmg_lw_pre.meta | 4 +-- physics/rrtmg_sw_post.meta | 4 +-- physics/rrtmg_sw_pre.meta | 4 +-- physics/rrtmgp_lw_aerosol_optics.meta | 6 ++-- physics/rrtmgp_lw_cloud_optics.meta | 6 ++-- physics/rrtmgp_lw_cloud_sampling.meta | 6 ++-- physics/rrtmgp_lw_gas_optics.meta | 7 +++-- physics/rrtmgp_lw_pre.meta | 6 ++-- physics/rrtmgp_lw_rte.meta | 7 +++-- physics/rrtmgp_sw_aerosol_optics.meta | 6 ++-- physics/rrtmgp_sw_cloud_optics.meta | 6 ++-- physics/rrtmgp_sw_cloud_sampling.meta | 6 ++-- physics/rrtmgp_sw_gas_optics.meta | 7 +++-- physics/rrtmgp_sw_rte.meta | 7 +++-- physics/samfdeepcnv.meta | 4 +-- physics/samfshalcnv.meta | 4 +-- physics/sascnvn.meta | 4 +-- physics/satmedmfvdif.meta | 4 +-- physics/satmedmfvdifq.meta | 4 +-- physics/sfc_cice.meta | 4 +-- physics/sfc_diag.meta | 4 +-- physics/sfc_diag_post.meta | 4 +-- physics/sfc_diff.meta | 4 +-- physics/sfc_drv.meta | 4 +-- physics/sfc_drv_ruc.meta | 4 +-- physics/sfc_noahmp_drv.meta | 4 +-- physics/sfc_nst.meta | 12 ++++---- physics/sfc_ocean.meta | 4 +-- physics/sfc_sice.meta | 4 +-- physics/shalcnv.meta | 4 +-- physics/shinhongvdif.meta | 4 +-- physics/ysuvdif.meta | 4 +-- 109 files changed, 328 insertions(+), 287 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index e1156c7fe..507643661 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_DCNV_generic_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -155,9 +155,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_DCNV_generic_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 763e848dc..ed7cd9629 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_GWD_generic_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -245,9 +245,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_GWD_generic_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 5f79092fb..320727eef 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_MP_generic_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -135,9 +135,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_MP_generic_post - type = properties + type = scheme dependencies = calpreciptype.f90,machine.F ######################################################################## diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 7049e8e85..972af4859 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_PBL_generic_pre - type = properties + type = scheme dependencies = GFS_PBL_generic.F90,machine.F ######################################################################## @@ -419,9 +419,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_PBL_generic_post - type = properties + type = scheme dependencies = GFS_PBL_generic.F90,machine.F ######################################################################## diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index da8388ae7..47fd151af 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_SCNV_generic_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -138,9 +138,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_SCNV_generic_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index 6aca658e3..d93e22328 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_diagtoscreen - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -130,9 +130,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_interstitialtoscreen - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -262,9 +262,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_abort - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -306,9 +306,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_checkland - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index f9c13df40..bcd4112c2 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_phys_time_vary - type = properties + type = scheme dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,num_parthds.F,ozinterp.f90,ozne_def.f,sfcsub.F ######################################################################## diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 3de1febd0..556aa80c7 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_phys_time_vary - type = properties + type = scheme dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f ######################################################################## diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index 18e9eed75..8ac28be30 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rad_time_vary - type = properties + type = scheme dependencies = machine.F,mersenne_twister.f,physparam.f,radcons.f90 ######################################################################## diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 8b8a6b878..b78be178a 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rad_time_vary - type = properties + type = scheme dependencies = machine.F,mersenne_twister.f,physparam.f,radcons.f90 ######################################################################## diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 04febd5d7..43c25ae2e 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmg_post - type = properties + type = scheme dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radsw_param.f ######################################################################## diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 5afbdfe30..0d20b87cc 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmg_pre - type = properties + type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90 ######################################################################## diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 408b41bf8..8377807d8 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmg_setup - type = properties + type = scheme dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,radlw_main.f,radlw_param.f,radsw_main.f,radsw_param.f ######################################################################## diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index d4fcf6547..24e4314dd 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmgp_lw_post - type = properties - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rrtmgp_aux.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + type = scheme + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rrtmgp_aux.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 173f7c4e8..67cc5d3e0 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmgp_pre - type = properties - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,rrtmg_lw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90,surface_perturbation.F90 + type = scheme + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f + dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,rrtmgp_aux.F90,rrtmg_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 412094787..c4a1ec4e5 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmgp_setup - type = properties + type = scheme dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f ######################################################################## diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 9f905cca3..34b0dda44 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmgp_sw_post - type = properties - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rrtmgp_aux.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + type = scheme + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 2851e0d80..bd42202c9 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_rrtmgp_sw_pre - type = properties - dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f,radiation_surface.f,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,surface_perturbation.F90 + type = scheme + dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 9effaabf2..85aceeee4 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_stochastics - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 24ed8f774..6dce915ac 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_rad_reset - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -42,9 +42,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_phys_reset - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -86,9 +86,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_1 - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -281,9 +281,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_2 - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -805,9 +805,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_stateout_reset - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -929,9 +929,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_stateout_update - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -1098,9 +1098,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_3 - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -1536,9 +1536,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_4 - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -1856,9 +1856,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_suite_interstitial_5 - type = properties + type = scheme dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 ######################################################################## diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 63184dca8..3be253c40 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_composites_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -644,9 +644,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_composites_inter - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -794,9 +794,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_composites_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index d1d9143b5..cc2d6e231 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_generic_pre - type = properties + type = scheme dependencies = machine.F,surface_perturbation.F90 ######################################################################## @@ -506,9 +506,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_generic_post - type = properties + type = scheme dependencies = machine.F,surface_perturbation.F90 ######################################################################## diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta index 16af00db3..a4d62cd29 100644 --- a/physics/GFS_surface_loop_control.meta +++ b/physics/GFS_surface_loop_control.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_loop_control_part1 - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -59,9 +59,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_surface_loop_control_part2 - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index d38922c6d..f1a088245 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_time_vary_pre - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 6b84da68c..189a5b05b 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = GFS_time_vary_pre - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 377620c6a..ca1e573ba 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cires_ugwp - type = properties + type = scheme # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp! dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90,cires_ugwp_solvers.F90,cires_ugwp_utils.F90,cires_orowam2017.f,cires_vert_lsatdis.F90,cires_vert_orodis.F90,cires_vert_wmsdis.F90,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 0791d6d9f..ccb7cf50f 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cires_ugwp_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index 71ba19c35..ab487ff22 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cnvc90 - type = properties + type = scheme dependencies = ######################################################################## diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index 28fd28fd2..42201b155 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cs_conv_pre - type = properties + type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## @@ -175,9 +175,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = cs_conv_post - type = properties + type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## @@ -245,9 +245,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = cs_conv - type = properties + type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## diff --git a/physics/cs_conv_aw_adj.meta b/physics/cs_conv_aw_adj.meta index 15142e121..626fd6d4b 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/cs_conv_aw_adj.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cs_conv_aw_adj - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 2f0c999cd..7c86d7952 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_gf_driver - type = properties + type = scheme dependencies = cu_gf_deep.F90,cu_gf_sh.F90,machine.F,physcons.F90 ######################################################################## diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 8e85ab3a2..43bc02545 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_gf_driver_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index fa23bf960..bfdebee59 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_gf_driver_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 331abfc14..8bc067735 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_ntiedtke - type = properties + type = scheme dependencies = machine.F,physcons.F90 ######################################################################## diff --git a/physics/cu_ntiedtke_post.meta b/physics/cu_ntiedtke_post.meta index 491febaeb..dfaee692d 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/cu_ntiedtke_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_ntiedtke_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/cu_ntiedtke_pre.meta b/physics/cu_ntiedtke_pre.meta index b5892ce10..411bb8fab 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/cu_ntiedtke_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = cu_ntiedtke_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index e2264a2ff..ce406e824 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = dcyc2t3 - type = properties + type = scheme dependencies = machine.F,physcons.F90 ######################################################################## diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index d57f334f9..ba15719c1 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = drag_suite - type = properties + type = scheme dependencies = ######################################################################## diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 037e5b463..128977e05 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = flake_driver - type = properties + type = scheme dependencies = flake.F90,machine.F ######################################################################## diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index a53687eb7..d9a58d8b5 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = shoc - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta index 2da5bbe11..2db340300 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/get_prs_fv3.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = get_prs_fv3 - type = properties + type = scheme dependencies = machine.F,physcons.F90 ######################################################################## @@ -96,9 +96,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = get_phi_fv3 - type = properties + type = scheme dependencies = machine.F,physcons.F90 ######################################################################## diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index ef226dbbd..3c9a53606 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = gfdl_cloud_microphys - type = properties + type = scheme dependencies = machine.F,module_mp_radar.F90,module_gfdl_cloud_microphys.F90 ######################################################################## diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta index 7369c34d3..d54baf1bb 100644 --- a/physics/gfdl_fv_sat_adj.meta +++ b/physics/gfdl_fv_sat_adj.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = fv_sat_adj - type = properties + type = scheme dependencies = machine.F,module_gfdl_cloud_microphys.F90,module_mp_radar.F90,multi_gases.F90,physcons.F90 ######################################################################## diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index e73deada0..2dba88b57 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = gmtb_scm_sfc_flux_spec - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/gscond.meta b/physics/gscond.meta index f8c524268..9012cc650 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = zhaocarr_gscond - type = properties + type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## diff --git a/physics/gwdc.meta b/physics/gwdc.meta index e0310b4ee..30f5fcbfd 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = gwdc_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -165,9 +165,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = gwdc - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -446,9 +446,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = gwdc_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 024c6781d..401024729 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = gwdps - type = properties + type = scheme dependencies = ######################################################################## diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 40ed95848..27476ae08 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = h2ophys - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta index dc06c1a72..d78343422 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = lsm_ruc_sfc_sice_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -101,9 +101,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = lsm_ruc_sfc_sice_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 80dcc4195..f61e6511f 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = m_micro - type = properties + type = scheme dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F ######################################################################## diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 591dcdc4c..ec0944f28 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = m_micro_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## @@ -290,9 +290,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = m_micro_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/machine.meta b/physics/machine.meta index 92d09e629..a000aa469 100644 --- a/physics/machine.meta +++ b/physics/machine.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = machine - type = properties + type = module dependencies = ######################################################################## diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index 00a0bbd34..48223113c 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = maximum_hourly_diagnostics - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index c396bc991..356ce74a9 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = myjpbl_wrapper - type = properties + type = scheme dependencies = module_BL_MYJPBL.F90 ######################################################################## diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index aab6a66e4..8938aeccd 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = myjsfc_wrapper - type = properties + type = scheme dependencies = module_SF_JSFC.F90 ######################################################################## diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 2ce69b270..c51b6f0f7 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mynnedmf_wrapper - type = properties + type = scheme dependencies = machine.F,module_bl_mynn.F90,physcons.F90 ######################################################################## diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 9b62aae52..59df18419 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mynnsfc_wrapper - type = properties + type = scheme dependencies = machine.F,module_sf_mynn.F90 ######################################################################## diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index 0f4041f10..089c770c2 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sgscloud_radpost - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 87e77657f..e74f5f7ee 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sgscloud_radpre - type = properties + type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f ######################################################################## diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 5a41ee2d0..31a26053f 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = hedmf - type = properties + type = scheme dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90,tridi.f ######################################################################## diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index 26a4e4409..d79245330 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = hedmf_hafs - type = properties + type = scheme dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90 ######################################################################## diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 3b7a50ad5..48754564f 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = moninshoc - type = properties + type = scheme dependencies = funcphys.f90,machine.F,tridi.f ######################################################################## diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 3c085600b..a0591ade8 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mp_fer_hires - type = properties + type = scheme dependencies = machine.F,module_MP_FER_HIRES.F90 ######################################################################## diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 01f38fa6a..427b2bc84 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mp_thompson - type = properties + type = scheme dependencies = machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 9f6d3e3b6..2c68fc78a 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mp_thompson_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index f14340a03..2511ba3bc 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = mp_thompson_pre - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/ozphys.meta b/physics/ozphys.meta index f9c29bd11..b43f7931c 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = ozphys - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 1c2cf364f..2db91982f 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = ozphys_2015 - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 5362137a5..b5637063c 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = phys_tend - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/precpd.meta b/physics/precpd.meta index 1435ead20..3d76d18ed 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = zhaocarr_precpd - type = properties + type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 ######################################################################## diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 00e390cb9..05fcf1de6 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_lw - type = properties + type = scheme dependencies = mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f ######################################################################## diff --git a/physics/radlw_param.meta b/physics/radlw_param.meta index 61aee1d37..05fe5af57 100644 --- a/physics/radlw_param.meta +++ b/physics/radlw_param.meta @@ -1,13 +1,28 @@ +[ccpp-table-properties] + name = topflw_type + type = ddt + dependencies = + [ccpp-arg-table] name = topflw_type type = ddt ######################################################################## +[ccpp-table-properties] + name = sfcflw_type + type = ddt + dependencies = + [ccpp-arg-table] name = sfcflw_type type = ddt ######################################################################## +[ccpp-table-properties] + name = module_radlw_parameters + type = module + dependencies = + [ccpp-arg-table] name = module_radlw_parameters type = module diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 679d3b8ca..30e1d850c 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_sw - type = properties + type = scheme dependencies = mersenne_twister.f,physcons.F90,physparam.f,radsw_datatb.f,radsw_param.f ######################################################################## diff --git a/physics/radsw_param.meta b/physics/radsw_param.meta index e0eb5ece8..7f7da3bdd 100644 --- a/physics/radsw_param.meta +++ b/physics/radsw_param.meta @@ -1,18 +1,38 @@ +[ccpp-table-properties] + name = topfsw_type + type = ddt + dependencies = + [ccpp-arg-table] name = topfsw_type type = ddt ######################################################################## +[ccpp-table-properties] + name = sfcfsw_type + type = ddt + dependencies = + [ccpp-arg-table] name = sfcfsw_type type = ddt ######################################################################## +[ccpp-table-properties] + name = cmpfsw_type + type = ddt + dependencies = + [ccpp-arg-table] name = cmpfsw_type type = ddt ######################################################################## +[ccpp-table-properties] + name = module_radsw_parameters + type = module + dependencies = + [ccpp-arg-table] name = module_radsw_parameters type = module diff --git a/physics/rascnv.meta b/physics/rascnv.meta index d92a6aadd..8a8cc0153 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rascnv - type = properties + type = scheme dependencies = ######################################################################## diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index d502e5bd1..9a40ceff1 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rayleigh_damp - type = properties + type = scheme dependencies = ######################################################################## diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 2b3c157a5..4886e600c 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_lw_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 2d6aa294f..fb7b9d3b0 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_lw_pre - type = properties + type = scheme dependencies = iounitdef.f,machine.F,radiation_surface.f ######################################################################## diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 3ed4600fd..da2272a54 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_sw_post - type = properties + type = scheme dependencies = machine.F,radsw_param.f ######################################################################## diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 55b365334..9088284bb 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmg_sw_pre - type = properties + type = scheme dependencies = iounitdef.f,machine.F,radiation_surface.f ######################################################################## diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 5093d66cc..8df363cb6 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_aerosol_optics - type = properties - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 + type = scheme + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 147cd7916..84115675f 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_cloud_optics - type = properties - dependencies = machine.F,rrtmg_lw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 + type = scheme + dependencies = machine.F,rrtmg_lw_cloud_optics.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 1868c408d..1d22e7e1e 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_cloud_sampling - type = properties - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 + type = scheme + dependencies = machine.F,mersenne_twister.f,physparam.f,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index dddb93c4c..56cc7cefa 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_gas_optics - type = properties - dependencies = machine.F,rrtmgp_aux.F90,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/mo_source_functions.F90 + type = scheme + dependencies = machine.F,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 + dependencies = rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index c8f7adc76..4dfc48203 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_pre - type = properties - dependencies = iounitdef.f,machine.F,physparam.f,radiation_surface.f,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + type = scheme + dependencies = iounitdef.f,machine.F,physparam.f,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index d7488ca4c..e918ea163 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_lw_rte - type = properties - dependencies = machine.F,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_source_functions.F90 + type = scheme + dependencies = machine.F,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rrtmgp_aux.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index a87c9a756..68979ae5b 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_sw_aerosol_optics - type = properties - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 + type = scheme + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index b9343a532..558d1423c 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_sw_cloud_optics - type = properties - dependencies = machine.F,physparam.f,rrtmg_sw_cloud_optics.F90,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 + type = scheme + dependencies = machine.F,physparam.f,rrtmg_sw_cloud_optics.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 158cf7c07..f1f3e03cc 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,7 +1,7 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_sw_cloud_sampling - type = properties - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90 + type = scheme + dependencies = machine.F,mersenne_twister.f,physparam.f,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index d2196736e..1d0c96547 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_sw_gas_optics - type = properties - dependencies = iounitdef.f,machine.F,radiation_gases.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90 + type = scheme + dependencies = iounitdef.f,machine.F,radiation_gases.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/mo_compute_bc.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 + dependencies = rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index e03e6be40..09fe99512 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -1,7 +1,8 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = rrtmgp_sw_rte - type = properties - dependencies = machine.F,radsw_param.f,rrtmgp_aux.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90,rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90,rte-rrtmgp/rrtmgp/mo_gas_optics.F90,rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90,rte-rrtmgp/rte/mo_rte_util_array.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/rte/mo_rte_sw.F90 + type = scheme + dependencies = machine.F,radsw_param.f,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rrtmgp_aux.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index f852a5002..7085e6577 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = samfdeepcnv - type = properties + type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F ######################################################################## diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index eb41f0ed5..6c7eedb82 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = samfshalcnv - type = properties + type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F ######################################################################## diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 2d1a21233..3031e8fd7 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sascnvn - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 97f146867..e34d778dc 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = satmedmfvdif - type = properties + type = scheme dependencies = funcphys.f90,machine.F,mfpblt.f,mfscu.f,tridi.f ######################################################################## diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index a92f99a22..75c5fbd3d 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = satmedmfvdifq - type = properties + type = scheme dependencies = funcphys.f90,machine.F,mfpbltq.f,mfscuq.f,tridi.f ######################################################################## diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index 5bce871cc..41d2956aa 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_cice - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index cf77201d7..6ede745b8 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_diag - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index 84c552f8a..492a97a0f 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_diag_post - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 9ff0baaa7..3f8c8e9de 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_diff - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 8801ff233..2e617fdb1 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = lsm_noah - type = properties + type = scheme dependencies = funcphys.f90,machine.F,set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 09f372c99..2c91a3d59 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = lsm_ruc - type = properties + type = scheme dependencies = machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index e8787ede8..73382d008 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = noahmpdrv - type = properties + type = scheme dependencies = funcphys.f90,machine.F,module_sf_noahmp_glacier.f90,module_sf_noahmplsm.f90,noahmp_tables.f90,set_soilveg.f ######################################################################## diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 09d2828a7..34e1331b2 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_nst - type = properties + type = scheme dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## @@ -646,9 +646,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_nst_pre - type = properties + type = scheme dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## @@ -779,9 +779,9 @@ optional = F ######################################################################## -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_nst_post - type = properties + type = scheme dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 6e7174d89..282ae6b89 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_ocean - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index ee17a4fc7..84bf7c6e7 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = sfc_sice - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index 15465a583..3fe29f5ef 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = shalcnv - type = properties + type = scheme dependencies = funcphys.f90,machine.F ######################################################################## diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index aff7962a0..4a557f253 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = shinhongvdif - type = properties + type = scheme dependencies = machine.F ######################################################################## diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index d0092569f..ae228bfe8 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -1,6 +1,6 @@ -[ccpp-scheme-properties] +[ccpp-table-properties] name = ysuvdif - type = properties + type = scheme dependencies = machine.F ######################################################################## From c751f08975232d19245372702a9d657c69abc513 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 7 Aug 2020 12:17:25 -0600 Subject: [PATCH 50/97] Update .gitmodules and submodule pointer for rte-rrtmgp for code review and testing --- .gitmodules | 6 ++++-- physics/rte-rrtmgp | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8421166ca..a49d2434f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,6 @@ [submodule "physics/rte-rrtmgp"] path = physics/rte-rrtmgp - url = https://github.com/RobertPincus/rte-rrtmgp - branch = dtc/ccpp + #url = https://github.com/earth-system-radiation/rte-rrtmgp + #branch = dtc/ccpp + url = https://github.com/climbfuji/rte-rrtmgp + branch = add_ccpp_table_properties_and_dependencies diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..aedbb6f74 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit aedbb6f74004e06794198111eb2b74e7390c28fc From 14aa89b4d72257374e4f6439b607eb035e6e8efb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 09:50:39 -0400 Subject: [PATCH 51/97] removingduplicate lines in GFS_suite_interstitial.F90 --- physics/GFS_suite_interstitial.F90 | 38 ------------------------------ 1 file changed, 38 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6176edbda..263e316a5 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -294,44 +294,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif endif - if (frac_grid) then - do i=1,im - tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell - if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) - else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) - endif - enddo - else - do i=1,im - if (dry(i)) then ! all land - adjsfculw(i) = adjsfculw_lnd(i) - elseif (icy(i)) then ! ice (and water) - tem = one - cice(i) - if (flag_cice(i)) then - if (wet(i) .and. abs(adjsfculw_wat(i)-huge) > epsln) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = ulwsfc_cice(i) - endif - else - if (wet(i) .and. abs(adjsfculw_wat(i)-huge) > epsln) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = adjsfculw_ice(i) - endif - endif - else ! all water - adjsfculw(i) = adjsfculw_wat(i) - endif - enddo - endif - do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf From d3dcae7ea20e27b9f4c774cea52acf7389e6d9e9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 10:57:47 -0400 Subject: [PATCH 52/97] fixing a typo in sfcsub.F --- physics/sfcsub.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index ee4a2ec09..a2d846aee 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -5576,7 +5576,7 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & do i=1,nprt ij = iwk(i) print 8004,rla(ij),rlo(ij),fld(ij),fldsmx - 8004 format(' snow land max. check. lat=',f5.1,i & + 8004 format(' snow land max. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif From c3ddc93d88012e45daca4b115b83074c019fb8bb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 12:15:15 -0400 Subject: [PATCH 53/97] reverting MAPL_kp back to MAPL_R8 --- physics/wv_saturation.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/wv_saturation.F b/physics/wv_saturation.F index f3047b542..b020096b8 100644 --- a/physics/wv_saturation.F +++ b/physics/wv_saturation.F @@ -9,7 +9,7 @@ !! This module contain some utility functions for saturation vapor pressure. module wv_saturation #ifdef GEOS5 - use MAPL_ConstantsMod, kp => MAPL_kp + use MAPL_ConstantsMod, kp => MAPL_R8 #endif #ifdef NEMS_GSM use funcphys, only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice From f3b797ffda59e9c0e0fe02b15564f530ef569229 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 12:47:39 -0400 Subject: [PATCH 54/97] moving definition of kp inside ifdef in wv_saturation.F --- physics/wv_saturation.F | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/wv_saturation.F b/physics/wv_saturation.F index b020096b8..b12b76a91 100644 --- a/physics/wv_saturation.F +++ b/physics/wv_saturation.F @@ -13,9 +13,8 @@ module wv_saturation #endif #ifdef NEMS_GSM use funcphys, only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice -#endif use machine, only : kp => kind_phys - +#endif !++jtb (comm out) From d7112c29fae6b709b154d61c8080fd4a04180d61 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 10 Aug 2020 16:44:52 -0600 Subject: [PATCH 55/97] Add [ccpp-table-properties] section to new RRTMGP metadata files, update submodule pointer for rte-rrtmgp --- physics/GFS_cloud_diagnostics.meta | 4 ++++ physics/GFS_rrtmgp_gfdlmp_pre.meta | 5 +++++ physics/GFS_rrtmgp_zhaocarr_pre.meta | 5 +++++ physics/rte-rrtmgp | 2 +- 4 files changed, 15 insertions(+), 1 deletion(-) diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index f78a76490..3778d6036 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -1,3 +1,7 @@ +[ccpp-table-properties] + name = GFS_cloud_diagnostics + type = scheme + ######################################################################## [ccpp-arg-table] name = GFS_cloud_diagnostics_run diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 932ffeb8f..7e0797538 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -1,3 +1,8 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_gfdlmp_pre + type = scheme + dependencies = rrtmgp_aux.F90 + ######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_gfdlmp_pre_run diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index 052da5798..11aac8437 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -1,3 +1,8 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_zhaocarr_pre + type = scheme + dependencies = rrtmgp_aux.F90 + ######################################################################## [ccpp-arg-table] name = GFS_rrtmgp_zhaocarr_pre_run diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index fb1d5ef53..f4b42d80d 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit fb1d5ef5305144a5d592240e150c7151fddf66f8 +Subproject commit f4b42d80d0ab5f621ab3a69facdf863efbcb37cb From f8ff2c0f0d0d34dc05a5be5dff72a697ff7dcd25 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 10 Aug 2020 17:11:11 -0600 Subject: [PATCH 56/97] Compile against correct version of mo_cloud_sampling.F90, fix name of function in error message --- physics/mo_cloud_sampling.F90 | 10 +++++----- physics/rrtmgp_lw_cloud_sampling.meta | 2 +- physics/rrtmgp_sw_cloud_sampling.meta | 2 +- physics/rte-rrtmgp | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 index 02741439f..4d4c8f44b 100644 --- a/physics/mo_cloud_sampling.F90 +++ b/physics/mo_cloud_sampling.F90 @@ -218,24 +218,24 @@ function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) resul nlay = size(randoms, 2) ngpt = size(randoms, 1) if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + error_msg = "sampled_mask_exp_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" return end if if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + error_msg = "sampled_mask_exp_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" return end if if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + error_msg = "sampled_mask_exp_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" return end if if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then - error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + error_msg = "sampled_mask_exp_ran: cloud fraction values out of range [0,1]" return end if if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then - error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" + error_msg = "sampled_mask_exp_ran: overlap_param values out of range [-1,1]" return end if ! diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index a15b99966..7d63b0d99 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rrtmgp_aux.F90 + dependencies = machine.F,mersenne_twister.f,physparam.f,mo_cloud_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 8df83a87d..397a14d12 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90,rrtmgp_aux.F90 + dependencies = machine.F,mersenne_twister.f,physparam.f,mo_cloud_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index f4b42d80d..51f718adb 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit f4b42d80d0ab5f621ab3a69facdf863efbcb37cb +Subproject commit 51f718adb36aa72bdc9dcc95b986dcbe5125e03a From 2e60cb5ebfe5a4057fc95f3f9ecd98675ee98a0a Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Tue, 11 Aug 2020 15:57:53 +0000 Subject: [PATCH 57/97] rte-rrtmgp submodule update --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..6ee0b62c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7 From e57e4dfc6f15028db881e715579d43c51c1281d7 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 Aug 2020 13:38:48 -0600 Subject: [PATCH 58/97] Renamed mo_cloud_sampling. Combined sampling routines. --- physics/mo_cloud_sampling.F90 | 398 --------------------------- physics/rrtmgp_lw_cloud_sampling.F90 | 95 +++---- physics/rrtmgp_sampling.F90 | 204 ++++++++++++++ physics/rrtmgp_sw_cloud_sampling.F90 | 90 +++--- 4 files changed, 274 insertions(+), 513 deletions(-) delete mode 100644 physics/mo_cloud_sampling.F90 create mode 100644 physics/rrtmgp_sampling.F90 diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 deleted file mode 100644 index 02741439f..000000000 --- a/physics/mo_cloud_sampling.F90 +++ /dev/null @@ -1,398 +0,0 @@ -! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) -! -! Contacts: Robert Pincus and Eli Mlawer -! email: rrtmgp@aer.com -! -! Copyright 2015-2019, Atmospheric and Environmental Research and -! Regents of the University of Colorado. All right reserved. -! -! Use and duplication is permitted under the terms of the -! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause -! ------------------------------------------------------------------------------------------------- -! -! This module provides a simple implementation of sampling for the -! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) -! Cloud optical properties, defined by band and assumed homogenous within each cell (column/layer), -! are randomly sampled to preserve the mean cloud fraction and one of several possible overlap assumptions -! Users supply random numbers with order ngpt,nlay,ncol -! These are only accessed if cloud_fraction(icol,ilay) > 0 so many values don't need to be filled in -! -! ------------------------------------------------------------------------------------------------- -module mo_cloud_sampling - use mo_rte_kind, only: wp, wl - use mo_optical_props, only: ty_optical_props_arry, & - ty_optical_props_1scl, & - ty_optical_props_2str, & - ty_optical_props_nstr - implicit none - private - public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran -contains - ! ------------------------------------------------------------------------------------------------- - ! - ! Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce - ! McICA-sampled cloud optical properties - ! - function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) - logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt - class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band - class(ty_optical_props_arry), intent(inout) :: clouds_sampled ! Defined by g-point - character(len=128) :: error_msg - ! ------------------------ - integer :: ncol,nlay,nbnd,ngpt - integer :: imom - ! ------------------------ - ! - ! Error checking - ! - error_msg = "" - if(.not. clouds%is_initialized()) then - error_msg = "draw_samples: cloud optical properties are not initialized" - return - end if - if(.not. clouds_sampled%is_initialized()) then - error_msg = "draw_samples: sampled cloud optical properties are not initialized" - return - end if - - ! - ! Variables clouds and clouds_sampled have to be of the same type (have the same set of fields) - ! nstr isn't supported - ! 2str is checked at assignment - ! - select type(clouds) - type is (ty_optical_props_1scl) - select type(clouds_sampled) - type is (ty_optical_props_2str) - error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" - return - type is (ty_optical_props_nstr) - error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" - return - end select - type is (ty_optical_props_nstr) - error_msg = "draw_samples: sampling isn't implemented yet for ty_optical_props_nstr" - return - end select - - ! - ! Spectral discretization - ! - if(.not. clouds%bands_are_equal(clouds_sampled)) then - error_msg = "draw_samples: by-band and sampled cloud properties spectral structure is different" - return - end if - - ! - ! Array extents - ! - ncol = clouds%get_ncol() - nlay = clouds%get_nlay() - nbnd = clouds%get_nband() - ngpt = clouds_sampled%get_ngpt() - if (any([size(cloud_mask,1), size(cloud_mask,2), size(cloud_mask,3)] /= [ncol,nlay,ngpt])) then - error_msg = "draw_samples: cloud mask and cloud optical properties have different ncol and/or nlay" - return - end if - if (any([clouds_sampled%get_ncol(), clouds_sampled%get_nlay()] /= [ncol,nlay])) then - error_msg = "draw_samples: sampled/unsampled cloud optical properties have different ncol and/or nlay" - return - end if - ! ------------------------ - ! - ! Finally - sample fields according to the cloud mask - ! - ! Optical depth assignment works for 1scl, 2str (also nstr) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%tau,clouds_sampled%tau) - ! - ! For 2-stream - ! - select type(clouds) - type is (ty_optical_props_2str) - select type(clouds_sampled) - type is (ty_optical_props_2str) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) - class default - error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" - end select - end select - end function draw_samples - ! ------------------------------------------------------------------------------------------------- - ! - ! Generate a McICA-sampled cloud mask for maximum-random overlap - ! - function sampled_mask_max_ran(randoms,cloud_frac,cloud_mask) result(error_msg) - real(wp), dimension(:,:,:), intent(in ) :: randoms !ngpt,nlay,ncol - real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay - logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt - character(len=128) :: error_msg - ! ------------------------ - integer :: ncol, nlay, ngpt, icol, ilay, igpt - integer :: cloud_lay_fst, cloud_lay_lst - real(wp), dimension(size(randoms,1)) :: local_rands - logical, dimension(size(randoms,2)) :: cloud_mask_layer - ! ------------------------ - ! - ! Error checking - ! - error_msg = "" - ncol = size(randoms, 3) - nlay = size(randoms, 2) - ngpt = size(randoms, 1) - if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" - return - end if - if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" - return - end if - if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then - error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" - return - end if - ! - ! We chould check the random numbers but that would be computationally heavy - ! - ! ------------------------ - ! - ! Construct the cloud mask for each column - ! - do icol = 1, ncol - cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp - if(.not. any(cloud_mask_layer)) then - cloud_mask(icol,1:nlay,1:ngpt) = .false. - cycle - end if - cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) - cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) - cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. - - ilay = cloud_lay_fst - local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - do ilay = cloud_lay_fst+1, cloud_lay_lst - if(cloud_mask_layer(ilay)) then - ! - ! Max-random overlap: - ! new random deviates if the adjacent layer isn't cloudy - ! same random deviates if the adjacent layer is cloudy - ! - if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - else - cloud_mask(icol,ilay,1:ngpt) = .false. - end if - end do - - cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. - end do - - end function sampled_mask_max_ran - ! ------------------------------------------------------------------------------------------------- - ! - ! Generate a McICA-sampled cloud mask for exponential-random overlap - ! The overlap parameter alpha is defined between pairs of layers - ! for layer i, alpha(i) describes the overlap betwen cloud_frac(i) and cloud_frac(i+1) - ! By skipping layers with 0 cloud fraction the code forces alpha(i) = 0 for cloud_frac(i) = 0. - ! - function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) result(error_msg) - real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol - real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay - real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 - logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt - character(len=128) :: error_msg - ! ------------------------ - integer :: ncol, nlay, ngpt, icol, ilay, igpt - integer :: cloud_lay_fst, cloud_lay_lst - real(wp) :: rho ! correlation coefficient - real(wp), dimension(size(randoms,1)) :: local_rands - logical, dimension(size(randoms,2)) :: cloud_mask_layer - ! ------------------------ - ! - ! Error checking - ! - error_msg = "" - ncol = size(randoms, 3) - nlay = size(randoms, 2) - ngpt = size(randoms, 1) - if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" - return - end if - if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" - return - end if - if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" - return - end if - - if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then - error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" - return - end if - if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then - error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" - return - end if - ! - ! We chould check the random numbers but that would be computationally heavy - ! - ! ------------------------ - ! Construct the cloud mask for each column - ! - do icol = 1, ncol - cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp - if(.not. any(cloud_mask_layer)) then - cloud_mask(icol,1:nlay,1:ngpt) = .false. - cycle - end if - cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) - cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) - cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. - - ilay = cloud_lay_fst - local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - do ilay = cloud_lay_fst+1, cloud_lay_lst - if(cloud_mask_layer(ilay)) then - ! - ! Exponential-random overlap: - ! new random deviates if the adjacent layer isn't cloudy - ! correlated deviates if the adjacent layer is cloudy - ! - if(cloud_mask_layer(ilay-1)) then - ! - ! Create random deviates correlated between this layer and the previous layer - ! (have to remove mean value before enforcing correlation) - ! - rho = overlap_param(icol,ilay-1) - local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & - sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp - else - local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - end if - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - end if - end do - - cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. - end do - end function sampled_mask_exp_ran - - ! ------------------------------------------------------------------------------------------------- - ! - ! Generate a McICA-sampled cloud mask for exponential-decorrelation overlap - ! The overlap parameter is defined between pairs of layers - ! - function sampled_mask_exp_dcorr(randoms1,randoms2,cloud_frac,overlap_param,cloud_mask) result(error_msg) - real(wp), dimension(:,:,:), intent(in ) :: randoms1,randoms2 ! ngpt,nlay,ncol - real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay - real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 - logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt - character(len=128) :: error_msg - ! ------------------------ - integer :: ncol, nlay, ngpt, icol, ilay, igpt - integer :: cloud_lay_fst, cloud_lay_lst - logical, dimension(size(randoms1,2)) :: cloud_mask_layer - ! ------------------------ - ! - ! Error checking - ! - error_msg = "" - ncol = size(randoms1, 3) - nlay = size(randoms1, 2) - ngpt = size(randoms1, 1) - if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" - return - end if - if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" - return - end if - if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" - return - end if - - if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then - error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" - return - end if - if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then - error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" - return - end if - - ! - do icol = 1, ncol - ! Column cloud-mask - cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp - - ! Skip column if no clouds - if(.not. any(cloud_mask_layer)) then - cloud_mask(icol,1:nlay,1:ngpt) = .false. - cycle - end if - - ! Pull out indices for First/Last cloudy layers - cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) - cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) - - ! Set cloud-mask in layers above cloud to false - cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. - - ! Loop over cloudy-layers - ! - ! First layer - ! - ilay = cloud_lay_fst - cloud_mask(icol,ilay,1:ngpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) - ! - ! Subsequent-layers - ! - do ilay = cloud_lay_fst+1, cloud_lay_lst - !if(cloud_mask_layer(ilay) .and. cloud_mask_layer(ilay-1)) then - where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay)) - cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) - elsewhere - cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) - endwhere - !else - ! cloud_mask(iCol,iLay,1:nGpt) = .false. - !endif - end do - - ! Set cloud-mask in layer below clouds to false - cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. - end do - - end function sampled_mask_exp_dcorr - ! ------------------------------------------------------------------------------------------------- - ! - ! Apply a true/false cloud mask to a homogeneous field - ! This could be a kernel - ! - subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_field,sampled_field) - integer, intent(in ) :: ncol,nlay,nbnd,ngpt - integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt - logical, dimension(ncol,nlay,ngpt), intent(in ) :: cloud_mask - real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: input_field - real(wp), dimension(ncol,nlay,ngpt), intent(out) :: sampled_field - - integer :: icol,ilay,ibnd,igpt - - do ibnd = 1, nbnd - do igpt = band_lims_gpt(1,ibnd), band_lims_gpt(2,ibnd) - do ilay = 1, nlay - sampled_field(1:ncol,ilay,igpt) = merge(input_field(1:ncol,ilay,ibnd), 0._wp, cloud_mask(1:ncol,ilay,igpt)) - end do - end do - end do - end subroutine apply_cloud_mask - -end module mo_cloud_sampling diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 1d6cc06a1..35ae3c4a8 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw use mo_optical_props, only: ty_optical_props_1scl - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran, draw_samples + use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -133,41 +133,30 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, enddo ! Cloud-overlap. - select case ( iovrlw ) - case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D, & - cld_frac, & - cldfracMCICA)) - case(3) ! Exponential decorrelation length overlap + ! Maximum-random + if (iovrlw == 1) then + call sampled_mask(rng3D, cld_frac, cldfracMCICA) + endif + ! Exponential decorrelation length overlap + if (iovrlw == 3) then ! Generate second RNG do iCol=1,ncol call random_setseed(ipseed_lw(icol),rng_stat) call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D, & - rng3D2, & - cld_frac, & - cloud_overlap_param(:,1:nLev-1), & - cldfracMCICA)) - case(4) ! Exponential overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - cld_frac, & - cloud_overlap_param(:,1:nLev-1), & - cldfracMCICA)) - case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - cld_frac, & - cloud_overlap_param(:,1:nLev-1), & - cldfracMCICA)) - end select - + call sampled_mask(rng3D, cld_frac, cldfracMCICA, & + overlap_param = cloud_overlap_param(:,1:nLev-1), & + randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovrlw == 4 .or. iovrlw == 5) then + call sampled_mask(rng3D, cld_frac, cldfracMCICA, & + overlap_param = cloud_overlap_param(:,1:nLev-1)) + endif + ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& draw_samples(cldfracMCICA, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -201,13 +190,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, !enddo ! Precipitation overlap. - select case ( iovrlw ) - case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D, & - precip_frac, & - precipfracSAMP)) - case(3) ! Exponential decorrelation length overlap + ! Maximum-random + if (iovrlw == 1) then + call sampled_mask(rng3D, precip_frac, precipfracSAMP) + endif + ! Exponential decorrelation length overlap + if (iovrlw == 3) then ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG !do iCol=1,ncol @@ -215,30 +203,21 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D, & - rng3D2, & - precip_frac, & - precip_overlap_param(:,1:nLev-1), & - precipfracSAMP)) - case(4) ! Exponential overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - precip_frac, & - precip_overlap_param(:,1:nLev-1), & - precipfracSAMP)) - case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - precip_frac, & - precip_overlap_param(:,1:nLev-1), & - precipfracSAMP)) - end select + call sampled_mask(rng3D, precip_frac, precipfracSAMP, & + overlap_param = precip_overlap_param(:,1:nLev-1), & + randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovrlw == 4 .or. iovrlw == 5) then + call sampled_mask(rng3D, precip_frac, precipfracSAMP, & + overlap_param = precip_overlap_param(:,1:nLev-1)) + endif + ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - draw_samples(precipfracSAMP, & - lw_optical_props_precipByBand, & + call check_error_msg('rrtmgp_lw_precip_sampling_run_draw_samples',& + draw_samples(precipfracSAMP, & + lw_optical_props_precipByBand, & lw_optical_props_precip)) ! #################################################################################### diff --git a/physics/rrtmgp_sampling.F90 b/physics/rrtmgp_sampling.F90 new file mode 100644 index 000000000..29a9064a2 --- /dev/null +++ b/physics/rrtmgp_sampling.F90 @@ -0,0 +1,204 @@ +! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-2019, Atmospheric and Environmental Research and +! Regents of the University of Colorado. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +! +! This module provides a simple implementation of sampling for the +! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) +! Cloud optical properties, defined by band and assumed homogenous within each cell (column/layer), +! are randomly sampled to preserve the mean cloud fraction and one of several possible overlap assumptions +! Users supply random numbers with order ngpt,nlay,ncol +! These are only accessed if cloud_fraction(icol,ilay) > 0 so many values don't need to be filled in +! +! Adapted by Dustin Swales on 8/11/2020 for use in UFS (NOAA-PSL/CU-CIRES) +! +! ------------------------------------------------------------------------------------------------- +module rrtmgp_sampling + use mo_rte_kind, only: wp, wl + use mo_optical_props, only: ty_optical_props_arry, & + ty_optical_props_1scl, & + ty_optical_props_2str, & + ty_optical_props_nstr + implicit none + private + public :: draw_samples, sampled_mask +contains + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce + ! McICA-sampled cloud optical properties + ! + ! ------------------------------------------------------------------------------------------------- + function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + ! Inputs + logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band + + ! Outputs + class(ty_optical_props_arry), intent(inout) :: clouds_sampled ! Defined by g-point + character(len=128) :: error_msg + + ! Local variables + integer :: ncol,nlay,nbnd,ngpt + integer :: imom + + error_msg = "" + + ! Array extents + ncol = clouds%get_ncol() + nlay = clouds%get_nlay() + nbnd = clouds%get_nband() + ngpt = clouds_sampled%get_ngpt() + + ! Optical depth assignment works for 1scl, 2str (also nstr) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%tau,clouds_sampled%tau) + ! + ! For 2-stream + ! + select type(clouds) + type is (ty_optical_props_2str) + select type(clouds_sampled) + type is (ty_optical_props_2str) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + class default + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + end select + end select + end function draw_samples + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask + ! + ! ------------------------------------------------------------------------------------------------- + subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2) + ! Inputs + real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + + ! Outputs + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + + ! Inputs (optional) + real(wp), dimension(:,:), intent(in ), optional :: overlap_param ! ncol,nlay-1 + real(wp), dimension(:,:,:), intent(in ), optional :: randoms2 ! ngpt,nlay,ncol + + ! Local variables + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp) :: rho + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + logical :: l_use_overlap_param = .false. + logical :: l_use_second_rng = .false. + character(len=128) :: error_msg + + ! Array dimensions + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + + ! Using cloud-overlap parameter (alpha)? + if (present(overlap_param)) l_use_overlap_param = .true. + + ! Using a second RNG? + if (present(randoms2)) l_use_second_rng = .true. + + ! Construct the cloud mask for each column + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + ! ################################################################################ + ! Max-random overlap + ! new random deviates if the adjacent layer isn't cloudy + ! same random deviates if the adjacent layer is cloudy + ! ################################################################################ + if (.not. l_use_overlap_param) then + if(cloud_mask_layer(ilay)) then + if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + else + cloud_mask(icol,ilay,1:ngpt) = .false. + end if + end if ! END COND: Maximum-random overlap + ! ################################################################################ + ! Exponential-random overlap + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy + ! ################################################################################ + if (l_use_overlap_param) then + if(cloud_mask_layer(ilay)) then + if(cloud_mask_layer(ilay-1)) then + ! Create random deviates correlated between this layer and the previous layer + ! (have to remove mean value before enforcing correlation). + rho = overlap_param(icol,ilay-1) + local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & + sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + else + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + end if + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + endif + endif ! END COND: Exponential/Exponential-random overlap + ! ################################################################################ + ! Exponential-decorrelation overlap + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy and decorrelation-length + ! ################################################################################ + if (l_use_overlap_param .and. l_use_second_rng) then + where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay)) + cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) + elsewhere + cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + end where + endif ! END COND: Exponential decorrelation-length + end do ! END LOOP: Layers + + ! Set cloud-mask in layer below clouds to false + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do ! END LOOP: Columns + + end subroutine sampled_mask + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a true/false cloud mask to a homogeneous field + ! This could be a kernel + ! + ! ------------------------------------------------------------------------------------------------- + subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_field,sampled_field) + integer, intent(in ) :: ncol,nlay,nbnd,ngpt + integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt + logical, dimension(ncol,nlay,ngpt), intent(in ) :: cloud_mask + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: input_field + real(wp), dimension(ncol,nlay,ngpt), intent(out) :: sampled_field + + integer :: icol,ilay,ibnd,igpt + + do ibnd = 1, nbnd + do igpt = band_lims_gpt(1,ibnd), band_lims_gpt(2,ibnd) + do ilay = 1, nlay + sampled_field(1:ncol,ilay,igpt) = merge(input_field(1:ncol,ilay,ibnd), 0._wp, cloud_mask(1:ncol,ilay,igpt)) + end do + end do + end do + end subroutine apply_cloud_mask + +end module rrtmgp_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 0a0511bc2..802cad840 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -3,8 +3,7 @@ module rrtmgp_sw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, & - sampled_mask_exp_ran, draw_samples + use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -137,40 +136,29 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd enddo ! Cloud overlap. - select case ( iovrsw ) - case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D, & - cld_frac(idxday(1:nDay),:), & - cldfracMCICA)) - case(3) ! Decorrelation-length overlap + ! Maximum-random overlap + if (iovrsw == 1) then + call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA) + endif + ! Decorrelation-length overlap + if (iovrsw == 3) then do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D, & - rng3D2, & - cld_frac(idxday(1:nDay),:), & - cloud_overlap_param(idxday(1:nDay),1:nLev-1), & - cldfracMCICA)) - case(4) ! Exponential overlap - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - cld_frac(idxday(1:nDay),:), & - cloud_overlap_param(idxday(1:nDay),1:nLev-1), & - cldfracMCICA)) - case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - cld_frac(idxday(1:nDay),:), & - cloud_overlap_param(idxday(1:nDay),1:nLev-1), & - cldfracMCICA)) - end select + call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & + overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& + randoms2 = rng3D2) + endif + ! Exponential overlap + if (iovrsw == 4 .or. iovrsw == 5) then + call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & + overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) + endif ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & draw_samples(cldfracMCICA, & sw_optical_props_cloudsByBand, & sw_optical_props_clouds)) @@ -204,41 +192,29 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd !enddo ! Precipitation overlap - select case ( iovrsw ) - case(1) ! Maximum-random - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D, & - precip_frac(idxday(1:nDay),:), & - precipfracSAMP)) - case(3) ! Exponential-random + ! Maximum-random + if (iovrsw == 1) then + call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP) + endif + ! Exponential decorrelation length overlap + if (iovrsw == 3) then !! Generate second RNG !do iday=1,nday ! call random_setseed(ipseed_sw(iday),rng_stat) ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D, & - rng3D2, & - precip_frac(idxday(1:nDay),:), & - precip_overlap_param(idxday(1:nDay),1:nLev-1), & - precipfracSAMP)) - case(4) ! Exponential overlap - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - precip_frac(idxday(1:nDay),:), & - precip_overlap_param(idxday(1:nDay),1:nLev-1), & - precipfracSAMP)) - case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D, & - precip_frac(idxday(1:nDay),:), & - precip_overlap_param(idxday(1:nDay),1:nLev-1), & - precipfracSAMP)) - end select - + call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP, & + overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1),& + randoms2 = rng3D2) + endif + if (iovrsw == 4 .or. iovrsw == 5) then + call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:),precipfracSAMP, & + overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1)) + endif + ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_precip_sampling_run_draw_samples', & draw_samples(precipfracSAMP, & sw_optical_props_precipByBand, & sw_optical_props_precip)) From 4c5224a91fa1cef8cf4a4f5950678f04ad729a40 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 11 Aug 2020 14:02:27 -0600 Subject: [PATCH 59/97] Add dummy call to get_alpha_exp to physics/module_SGSCloud_RadPre.F90, merge get_alpha from RRTMG with get_alpha_exp from RRTMGP --- physics/GFS_rrtmgp_zhaocarr_pre.F90 | 2 +- physics/module_SGSCloud_RadPre.F90 | 34 ++++++++++++++++++++++++++--- physics/module_SGSCloud_RadPre.meta | 8 +++++++ physics/radiation_clouds.f | 30 ++++++++++++------------- physics/radlw_main.f | 2 +- physics/radsw_main.f | 2 +- 6 files changed, 57 insertions(+), 21 deletions(-) diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.F90 b/physics/GFS_rrtmgp_zhaocarr_pre.F90 index ac9fb7446..35b404b45 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.F90 +++ b/physics/GFS_rrtmgp_zhaocarr_pre.F90 @@ -6,7 +6,7 @@ module GFS_rrtmgp_zhaocarr_pre use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg use funcphys, only: fpvs - use module_radiation_clouds, only: get_alpha_dcorr + use module_radiation_clouds, only: get_alpha_dcorr ! Zhao-Carr MP parameters. real(kind_phys), parameter :: & diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 5a1a2744f..23bc29b11 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -49,6 +49,7 @@ subroutine sgscloud_radpre_run( & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & imp_physics, imp_physics_gfdl,& + iovr, & errmsg, errflg ) ! should be moved to inside the mynn: @@ -81,6 +82,7 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), dimension(im,nlay), intent(in) :: plyr, dz real(kind=kind_phys), dimension(im,5), intent(inout) :: cldsa integer, dimension(im,3), intent(inout) :: mbota, mtopa + integer, intent(in) :: iovr character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -93,6 +95,9 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), dimension(im) :: rxlat real (kind=kind_phys):: Tc, iwc integer :: i, k, id + ! DH* 20200723 - see comment at the end of this routine around 'gethml' + real(kind=kind_phys), dimension(im,nlay) :: alpha_dummy + ! *DH ! PARAMETERS FOR RANDALL AND XU (1996) CLOUD FRACTION REAL, PARAMETER :: coef_p = 0.25, coef_gamm = 0.49, coef_alph = 100. @@ -123,7 +128,7 @@ subroutine sgscloud_radpre_run( & if (h2oliq > clwt) then onemrh= max( 1.e-10, 1.0-rhgrid ) - tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan tem1 = 100.0 / tem1 value = max( min( tem1*(h2oliq-clwt), 50.0 ), 0.0 ) tem2 = sqrt( sqrt(rhgrid) ) @@ -304,12 +309,35 @@ subroutine sgscloud_radpre_run( & cldcnv = 0. +! DH* 20200723 +! iovr == 4 or 5 requires alpha, which is computed in GFS_rrmtg_pre, +! which comes after sgscloud_radpre. Computing alpha here requires +! a lot more input variables and computations (dzlay etc.), and +! recomputing it in GFS_rrmtg_pre is a waste of time. Workaround: +! pass a dummy array initialized to zero to gethml for other values of iovr. + if ( iovr == 4 .or. iovr == 5 ) then + errmsg = 'Logic error in sgscloud_radpre: iovr==4 or 5 not implemented' + errflg = 1 + return + end if +!! Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options +! if ( iovr == 4 .or. iovr == 5 ) then +! call get_alpha_exp & +!! --- inputs: +! (im, nlay, dzlay, iovr, latdeg, julian, yearlen, clouds1, & +!! --- outputs: +! alpha & +! ) +! endif + alpha_dummy = 0.0 +! *DH 2020723 + !> - Recompute the diagnostic high, mid, low, total and bl cloud fraction call gethml & ! --- inputs: - ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, im, nlay, & + ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, alpha_dummy, & ! --- outputs: - cldsa, mtopa, mbota) + im, nlay, cldsa, mtopa, mbota) !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 2658e8638..857ab884b 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -341,6 +341,14 @@ type = integer intent = in optional = F +[iovr] + standard_name = flag_for_max_random_overlap_clouds_for_radiation + long_name = max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 5e9aa465e..828db4ed0 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -837,9 +837,9 @@ subroutine progcld1 & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -1309,9 +1309,9 @@ subroutine progcld2 & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -1732,9 +1732,9 @@ subroutine progcld3 & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -2095,9 +2095,9 @@ subroutine progcld4 & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -2449,9 +2449,9 @@ subroutine progcld4o & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -2817,9 +2817,9 @@ subroutine progcld5 & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -3212,9 +3212,9 @@ subroutine progclduni & enddo endif -!> - Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha & + call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & ! --- outputs: @@ -3761,7 +3761,7 @@ subroutine get_alpha_exp & ! random, and blocks of cloudy layers separated by one or more ! ! clear layers are correlated randomly. ! ! ! -! usage: call get_alpha ! +! usage: call get_alpha_exp ! ! ! ! subprograms called: none ! ! ! diff --git a/physics/radlw_main.f b/physics/radlw_main.f index cdcb91b48..f470ad109 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -2060,7 +2060,7 @@ subroutine mcica_subcol & ! ! NOTE: The code below is identical for case (4) and (5) because the ! distinction in the vertical correlation between EXP and ER is already -! built into the specification of alpha (in subroutine get_alpha). +! built into the specification of alpha (in subroutine get_alpha_exp). ! --- setup 2 sets of random numbers diff --git a/physics/radsw_main.f b/physics/radsw_main.f index d285a8901..3b975313b 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -2181,7 +2181,7 @@ subroutine mcica_subcol & ! ! NOTE: The code below is identical for case (4) and (5) because the ! distinction in the vertical correlation between EXP and ER is already -! built into the specification of alpha (in subroutine get_alpha). +! built into the specification of alpha (in subroutine get_alpha_exp). ! --- setup 2 sets of random numbers From 767f9b577306b0c86a9f867cd036cd4cb0059698 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 13 Aug 2020 08:16:54 -0600 Subject: [PATCH 60/97] Update dependencies for physics/rrtmgp_lw_cloud_sampling.meta and physics/rrtmgp_sw_cloud_sampling.meta --- physics/rrtmgp_lw_cloud_sampling.meta | 2 +- physics/rrtmgp_sw_cloud_sampling.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 7d63b0d99..ff161d902 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,mo_cloud_sampling.F90,rrtmgp_aux.F90 + dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 397a14d12..7890d750e 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,mo_cloud_sampling.F90,rrtmgp_aux.F90 + dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,rrtmgp_aux.F90 ######################################################################## [ccpp-arg-table] From 0249e670919dd32cb7810b57fdf0823e8569c8df Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Tue, 11 Aug 2020 15:57:53 +0000 Subject: [PATCH 61/97] rte-rrtmgp submodule update --- physics/GFS_rrtmgp_sw_pre.F90 | 11 +++++------ physics/rte-rrtmgp | 2 +- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 2683a637a..f6aac60b1 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -40,17 +40,16 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ me, & ! Current MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - n_var_lndp & ! Number of surface variables perturbed + n_var_lndp, & ! Number of surface variables perturbed lndp_type ! Type of land perturbations scheme used - character(len=3), dimension(n_var_lndp), intent(in) :: + character(len=3), dimension(n_var_lndp), intent(in) :: & lndp_var_list - real(kind_phys), dimension(n_var_lndp), intent(in) :: + real(kind_phys), dimension(n_var_lndp), intent(in) :: & lndp_prt_list logical,intent(in) :: & - lsswr, ! Call RRTMGP SW radiation? + lsswr ! Call RRTMGP SW radiation? real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep - lndp_alb ! Magnitude of surface albedo perturbation (frac) + solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..6ee0b62c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7 From 43ba47d015fb6d136ebd503b4d17093ac6a26467 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 18 Aug 2020 17:26:03 -0600 Subject: [PATCH 62/97] fix diagnostic tendencies in moninedmf.f, satmedmfvdifq.F, module_MYNNPBL_wrapper.F90, ysuvdif.F90, shinhongvdif.F90 --- physics/module_MYNNPBL_wrapper.F90 | 62 +++++++----------------- physics/module_bl_mynn.F90 | 2 +- physics/moninedmf.f | 15 ++---- physics/moninedmf.meta | 8 ---- physics/satmedmfvdifq.F | 4 +- physics/shinhongvdif.F90 | 46 +++++++++++++++++- physics/shinhongvdif.meta | 76 ++++++++++++++++++++++++++++++ physics/ysuvdif.F90 | 46 +++++++++++++++++- physics/ysuvdif.meta | 76 ++++++++++++++++++++++++++++++ 9 files changed, 264 insertions(+), 71 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 8fd727148..f188ebbb7 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -708,16 +708,14 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - if_lsidea: if (lsidea) then - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + RTHBLTEN(i,k)*exner(i,k)*dtf - elseif(ldiag3d) then - do k=1,levs - do i=1,im - tem = RTHBLTEN(i,k)*exner(i,k) - (htrlw(i,k)+htrsw(i,k)*xmu(i)) - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + tem*dtf - enddo - enddo - endif if_lsidea + + if (lsidea .or. ldiag3d) then + do k = 1, levs + do i = 1, im + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + RTHBLTEN(i,k)*exner(i,k)*dtf + enddo + enddo + endif endif accum_duvt3dt !Update T, U and V: !do k = 1, levs @@ -739,13 +737,6 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif !Update moist species: !do k=1,levs ! do i=1,im @@ -770,13 +761,6 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -800,13 +784,6 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -830,13 +807,6 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -858,15 +828,15 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif endif - + + if(lssav .and. ldiag3d .and. qdiag3d) then + do k=1,levs + do i=1,im + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf + enddo + enddo + endif if (lprnt) then print* diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 2c1ce9fe0..fa892eba8 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3132,7 +3132,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & - & + diss_heat(k)*delt*dheat_opt + & + & diss_heat(k)*delt*dheat_opt + & & sub_thl(k)*delt + det_thl(k)*delt ENDDO diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 63edc3486..c8bf103fc 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -64,7 +64,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,lssav,ldiag3d,qdiag3d,lsidea,ntoz, & + & xkzminv,moninq_fac,lssav,ldiag3d,qdiag3d,ntoz, & & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & & flag_for_pbl_generic_tend, errmsg,errflg) ! @@ -76,7 +76,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! arguments ! - logical, intent(in) :: lprnt,lssav,ldiag3d,qdiag3d,lsidea + logical, intent(in) :: lprnt,lssav,ldiag3d,qdiag3d logical, intent(in) :: flag_for_pbl_generic_tend integer, intent(in) :: ipr integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz @@ -1043,14 +1043,9 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend if(lssav .and. ldiag3d .and. .not. & & flag_for_pbl_generic_tend) then - if(lsidea) then - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*rdt - else - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + & - & ((ttend-hlw(i,k)-swh(i,k)*xmu(i))*rdt) - endif + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt if(qdiag3d) then - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*rdt + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt endif endif enddo @@ -1071,7 +1066,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & is = (kk-1) * km do k = 1, km do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + qtend = (a2(i,k+is)-q1(i,k,kk)) do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend enddo enddo diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 196862ae6..b55329717 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -515,14 +515,6 @@ type = logical intent = in optional = F -[lsidea] - standard_name = flag_idealized_physics - long_name = flag for idealized physics - units = flag - dimensions = () - type = logical - intent = in - optional = F [ntoz] standard_name = index_for_ozone long_name = tracer index for ozone mixing ratio diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f192788fe..28c30e55b 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1425,14 +1425,14 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & do k = 1,km do i = 1,im ttend = (f1(i,k)-t1(i,k))*rdt - dt3dt(i,k) = dt3dt(i,k)+dspfac*ttend*delt + dt3dt(i,k) = dt3dt(i,k)+ttend*delt enddo enddo if(qdiag3d) then do k = 1,km do i = 1,im qtend = (f2(i,k)-q1(i,k,1))*rdt - dq3dt(i,k) = dq3dt(i,k)+dspfac*qtend*delt + dq3dt(i,k) = dq3dt(i,k)+qtend*delt enddo enddo endif diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 83270a08d..4032f1828 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -34,7 +34,9 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dusfc,dvsfc,dtsfc,dqsfc, & dt,kpbl1d, & u10,v10, & - dx,errmsg,errflg ) + dx,lssav,ldiag3d,qdiag3d, & + flag_for_pbl_generic_tend,ntoz,du3dt_PBL,dv3dt_PBL, & + dt3dt_PBL,dq3dt_PBL,do3dt_PBL,errmsg,errflg ) use machine , only : kind_phys ! @@ -104,8 +106,10 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & real(kind=kind_phys),parameter :: cpent = -0.4,rigsmax = 100. real(kind=kind_phys),parameter :: entfmin = 1.0, entfmax = 5.0 ! 1D in - integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw,ntoz real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt + logical, intent(in ) :: lssav, ldiag3d, qdiag3d, & + flag_for_pbl_generic_tend ! 3D in real(kind=kind_phys), dimension(im, km) , & intent(in ) :: phil, & @@ -127,6 +131,8 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ttnp real(kind=kind_phys), dimension(im, km, ntrac ) , & intent(inout) :: qtnp + real(kind=kind_phys), dimension(im,km) , & + intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL ! 2D in integer, dimension(im) , & intent(in ) :: landmask @@ -956,6 +962,14 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & endif enddo enddo + if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = kte,kts,-1 + do i = its,ite + ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*dtstep + enddo + enddo + endif ! ! compute tridiagonal matrix elements for moisture, clouds, and gases ! @@ -1080,6 +1094,14 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & tvflux_e(i,k) = tflux_e(i,k) + qflux_e(i,k)*ep1*thx(i,k) enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = kte,kts,-1 + do i = its,ite + qtend = (f3(i,k,1)-qx(i,k,1))*rdt + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*dtstep + enddo + enddo + endif ! print*,"qtnp:",maxval(qtnp(:,:,1)),minval(qtnp(:,:,1)) ! do k = kts,kte @@ -1109,6 +1131,16 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo endif enddo + if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & + & .not. flag_for_pbl_generic_tend) then + ic = ntoz + do k = kte,kts,-1 + do i = its,ite + qtend = f3(i,k,ic)-qx(i,k,ic) + do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend + enddo + enddo + endif endif ! ! compute tridiagonal matrix elements for momentum @@ -1200,6 +1232,16 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) enddo enddo + if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = kte,kts,-1 + do i = its,ite + utend = (f1(i,k)-ux(i,k))*rdt + vtend = (f2(i,k)-vx(i,k))*rdt + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*dtstep + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*dtstep + enddo + enddo + endif ! do i = its,ite kpbl1d(i) = kpbl(i) diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 08646d7b9..5fa62cd27 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -407,6 +407,82 @@ kind = kind_phys intent = in optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[flag_for_pbl_generic_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dt3dt_PBL] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_PBL] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[do3dt_PBL] + standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL + long_name = cumulative change in ozone mixing ratio due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 51ed599f0..75c0b31d3 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -33,7 +33,9 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & landmask,heat,evap,wspd,br, & g,rd,cp,rv,ep1,ep2,xlv, & dusfc,dvsfc,dtsfc,dqsfc, & - dt,kpbl1d,u10,v10,errmsg,errflg ) + dt,kpbl1d,u10,v10,lssav,ldiag3d,qdiag3d, & + flag_for_pbl_generic_tend,ntoz,du3dt_PBL,dv3dt_PBL, & + dt3dt_PBL,dq3dt_PBL,do3dt_PBL,errmsg,errflg ) use machine , only : kind_phys ! @@ -59,7 +61,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ! !------------------------------------------------------------------------------------- ! input variables - integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw,ntoz real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt real(kind=kind_phys), dimension( im,km ), & @@ -76,6 +78,8 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & u10,v10,xmu integer, dimension(im) ,& intent(in ) :: landmask + logical, intent(in ) :: lssav, ldiag3d, qdiag3d, & + flag_for_pbl_generic_tend ! !---------------------------------------------------------------------------------- ! input/output variables @@ -84,6 +88,8 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(inout) :: qtnp + real(kind=kind_phys), dimension(im,km) , & + intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL ! !--------------------------------------------------------------------------------- ! output variables @@ -847,6 +853,14 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k) enddo enddo + if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = km,1,-1 + do i = 1,im + ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*dtstep + enddo + enddo + endif ! ! compute tridiagonal matrix elements for moisture, clouds, and gases ! @@ -955,6 +969,14 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dqsfc(i) = dqsfc(i)+qtend*conq*del(i,k) enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = km,1,-1 + do i = 1,im + qtend = (f3(i,k,1)-qx(i,k,1))*rdt + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*dtstep + enddo + enddo + endif ! if(ndiff.ge.2) then do ic = 2,ndiff @@ -965,6 +987,16 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo enddo + if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & + & .not. flag_for_pbl_generic_tend) then + ic = ntoz + do k = km,1,-1 + do i = 1,im + qtend = f3(i,k,ic)-qx(i,k,ic) + do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend + enddo + enddo + endif endif ! ! compute tridiagonal matrix elements for momentum @@ -1046,6 +1078,16 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) enddo enddo + if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then + do k = km,1,-1 + do i = 1,im + utend = (f1(i,k)-ux(i,k))*rdt + vtend = (f2(i,k)-vx(i,k))*rdt + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*dtstep + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*dtstep + enddo + enddo + endif ! !---- end of vertical diffusion ! diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index c040233a7..29996c6fb 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -425,6 +425,82 @@ kind = kind_phys intent = in optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[flag_for_pbl_generic_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dt3dt_PBL] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_PBL] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[do3dt_PBL] + standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL + long_name = cumulative change in ozone mixing ratio due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 38ae970136b1b632a1cec0447f0db0407298c4f1 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 19 Aug 2020 09:34:47 -0600 Subject: [PATCH 63/97] add check for generic PBL tendencies flag within PBL schemes that weren't already doing so --- physics/module_MYNNPBL_wrapper.F90 | 10 ++++++---- physics/module_MYNNPBL_wrapper.meta | 8 ++++++++ physics/satmedmfvdifq.F | 12 ++++++------ physics/satmedmfvdifq.meta | 8 ++++++++ 4 files changed, 28 insertions(+), 10 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index f188ebbb7..6011c203e 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -82,6 +82,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_ice_cloud, dqdt_ozone, & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, & + & flag_for_pbl_generic_tend, & & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & & do3dt_PBL, dq3dt_PBL, dt3dt_PBL, & & htrsw, htrlw, xmu, & @@ -190,7 +191,8 @@ SUBROUTINE mynnedmf_wrapper_run( & ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & - lprnt, do_mynnsfclay + lprnt, do_mynnsfclay, & + flag_for_pbl_generic_tend INTEGER, INTENT(IN) :: & & bl_mynn_cloudpdf, & & bl_mynn_mixlength, & @@ -700,7 +702,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo accum_duvt3dt: if(lssav) then - if(ldiag3d) then + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then do k = 1, levs do i = 1, im du3dt_PBL(i,k) = du3dt_PBL(i,k) + RUBLTEN(i,k)*dtf @@ -709,7 +711,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo endif - if (lsidea .or. ldiag3d) then + if (lsidea .or. (ldiag3d .and. .not. flag_for_pbl_generic_tend)) then do k = 1, levs do i = 1, im dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + RTHBLTEN(i,k)*exner(i,k)*dtf @@ -830,7 +832,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo endif - if(lssav .and. ldiag3d .and. qdiag3d) then + if(lssav .and. (ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend)) then do k=1,levs do i=1,im dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 43f14ad5f..552a95133 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -997,6 +997,14 @@ kind = kind_phys intent = inout optional = F +[flag_for_pbl_generic_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F [du3dt_PBL] standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 28c30e55b..63a67c810 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -65,7 +65,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & - & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,ldiag3d,qdiag3d, & + & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,gen_tend,ldiag3d,qdiag3d, & & errmsg,errflg) ! use machine , only : kind_phys @@ -78,7 +78,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(in) :: kinver(im) integer, intent(in) :: islimsk(im) integer, intent(out) :: kpbl(im) - logical, intent(in) :: ldiag3d,qdiag3d + logical, intent(in) :: gen_tend,ldiag3d,qdiag3d ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -1421,7 +1421,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo enddo - if(ldiag3d) then + if(ldiag3d .and. .not. gen_tend) then do k = 1,km do i = 1,im ttend = (f1(i,k)-t1(i,k))*rdt @@ -1448,7 +1448,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo - if(ldiag3d .and. qdiag3d .and. ntoz>0) then + if(ldiag3d .and. .not. gen_tend .and. qdiag3d .and. ntoz>0) then kk=ntoz is = (kk-1) * km do k = 1, km @@ -1471,7 +1471,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & tdt(i,k) = tdt(i,k) + dspfac * ttend enddo enddo - if(ldiag3d) then + if(ldiag3d .and. .not. gen_tend) then do k = 1,km1 do i = 1,im ttend = diss(i,k) / cp @@ -1555,7 +1555,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo enddo - if(ldiag3d) then + if(ldiag3d .and. .not. gen_tend) then do k = 1,km do i = 1,im utend = (f1(i,k)-u1(i,k))*rdt diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 397d71537..6adc7292a 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -640,6 +640,14 @@ kind = kind_phys intent = inout optional = F +[gen_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields From 1ce44ad9cac5cd201d9f9da53a3439806f608f4b Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 19 Aug 2020 09:43:49 -0600 Subject: [PATCH 64/97] check for generic PBL tendencies in satmedmfvdif and remove tests for diagnostic calculation outside of loops --- physics/satmedmfvdif.F | 40 +++++++++++++++++++++++++++------------ physics/satmedmfvdif.meta | 8 ++++++++ 2 files changed, 36 insertions(+), 12 deletions(-) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index f00fb3776..ec6add8a5 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -62,7 +62,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s, & & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL, & - & ldiag3d,qdiag3d,errmsg,errflg) + & gen_tend,ldiag3d,qdiag3d,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,7 +74,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) ! - logical, intent(in) :: ldiag3d, qdiag3d + logical, intent(in) :: gen_tend, ldiag3d, qdiag3d real(kind=kind_phys), intent(inout), dimension(:,:) :: & & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL ! @@ -1397,14 +1397,24 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & rtg(i,k,1) = rtg(i,k,1)+qtend dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend - if(ldiag3d) then - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt - if(qdiag3d) then - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt - endif - endif enddo enddo + if (ldiag3d .and. .not. gen_tend) then + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt + enddo + enddo + if (qdiag3d) then + do k = 1,km + do i = 1,im + qtend = (f2(i,k)-q1(i,k,1))*rdt + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt + enddo + enddo + endif + endif ! if(ntrac1 >= 2) then do kk = 2, ntrac1 @@ -1503,12 +1513,18 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & dv(i,k) = dv(i,k)+vtend dusfc(i) = dusfc(i)+conw*del(i,k)*utend dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend - if(ldiag3d) then - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt - endif enddo enddo + if (ldiag3d .and. .not. gen_tend) then + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + vtend = (f2(i,k)-v1(i,k))*rdt + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt + enddo + enddo + endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> -# Save PBL height for diagnostic purpose diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index c4230b950..1695d56e3 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -588,6 +588,14 @@ kind = kind_phys intent = inout optional = F +[gen_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields From 0f6528b03babcfe530d0295107e0ceb3b5afe14b Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 19 Aug 2020 13:52:56 -0600 Subject: [PATCH 65/97] add PBL tendencies to MYJ and SHOC schemes --- physics/module_MYJPBL_wrapper.F90 | 26 ++++++++++- physics/module_MYJPBL_wrapper.meta | 53 ++++++++++++++++++++++ physics/moninshoc.f | 47 +++++++++++++++++++- physics/moninshoc.meta | 70 ++++++++++++++++++++++++++++++ 4 files changed, 192 insertions(+), 4 deletions(-) diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index d239013b4..5924de96f 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -40,7 +40,9 @@ SUBROUTINE myjpbl_wrapper_run( & & dusfc,dvsfc,dtsfc,dqsfc, & & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & & con_cp,con_g,con_rd, & - & me, lprnt, errmsg, errflg ) + & me, lprnt, dt3dt_PBL, du3dt_PBL, dv3dt_PBL, & + & dq3dt_PBL, gen_tend, ldiag3d, qdiag3d, & + & errmsg, errflg ) ! @@ -79,7 +81,7 @@ SUBROUTINE myjpbl_wrapper_run( & integer,intent(in) :: im, levs integer,intent(in) :: kdt, me integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl - logical,intent(in) :: restart,do_myjsfc,lprnt + logical,intent(in) :: restart,do_myjsfc,lprnt,ldiag3d,qdiag3d,gen_tend real(kind=kind_phys),intent(in) :: con_cp, con_g, con_rd real(kind=kind_phys),intent(in) :: dt_phs, xkzm_m, xkzm_h, xkzm_s @@ -111,6 +113,8 @@ SUBROUTINE myjpbl_wrapper_run( & dudt, dvdt, dtdt real(kind=kind_phys),dimension(im,levs-1),intent(out) :: & dkt + real(kind=kind_phys),dimension(:,:),intent(inout) :: & + du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL !MYJ-4D real(kind=kind_phys),dimension(im,levs,ntrac),intent(inout) :: & @@ -576,6 +580,24 @@ SUBROUTINE myjpbl_wrapper_run( & dqdt(i,k,ntcw)=dqdt(i,k,ntcw)+rqcblten(i,k1) end do end do + if (ldiag3d .and. .not. gen_tend) then + do k=1,levs + k1=levs+1-k + do i=1,im + du3dt_PBL(i,k) = rublten(i,k1)*dt_phs + dv3dt_PBL(i,k) = rvblten(i,k1)*dt_phs + dt3dt_PBL(i,k) = rthblten(i,k1)*exner(i,k1)*dt_phs + end do + end do + if (qdiag3d) then + do k=1,levs + k1=levs+1-k + do i=1,im + dq3dt_PBL(i,k) = rqvblten(i,k1)*dt_phs + end do + end do + end if + end if if (lprnt1) then diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index fa1fe17c4..d3ae21545 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -624,6 +624,59 @@ type = logical intent = in optional = F +[dt3dt_PBL] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_PBL] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[gen_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 275d979fe..eb9a5d963 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -31,7 +31,9 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & prsi,del,prsl,prslk,phii,phil,delt, & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & grav, rd, cp, hvap, fv, + & grav,rd,cp,hvap,fv,ntoz,dt3dt_PBL, + & du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL, + & gen_tend,ldiag3d,qdiag3d, & errmsg,errflg) ! use machine , only : kind_phys @@ -42,7 +44,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! arguments ! integer, intent(in) :: im, - & km, ntrac, ntcw, ncnd, ntke + & km, ntrac, ntcw, ncnd, ntke, ntoz integer, dimension(im), intent(in) :: kinver real(kind=kind_phys), intent(in) :: delt, @@ -60,6 +62,11 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg + real(kind=kind_phys), dimension(:,:), intent(inout) :: + & du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL + logical, intent(in) :: ldiag3d, + & qdiag3d, gen_tend + integer, dimension(im), intent(out) :: kpbl real(kind=kind_phys), dimension(im), intent(out) :: dusfc, & dvsfc, dtsfc, dqsfc, hpbl @@ -441,6 +448,22 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, dqsfc(i) = dqsfc(i) + del(i,k)*qtend enddo enddo + if(ldiag3d .and. .not. gen_tend) then + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend + enddo + enddo + if(qdiag3d) then + do k = 1,km + do i = 1,im + qtend = (a2(i,k)-q1(i,k,1)) + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend + enddo + enddo + endif + endif do i = 1,im dtsfc(i) = dtsfc(i) * cont dqsfc(i) = dqsfc(i) * conq @@ -458,6 +481,16 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif enddo + if(ldiag3d .and. ntoz>0 .and. qdiag3d .and. .not. gen_tend) then + kk = ntoz + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk)) + do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend + enddo + enddo + endif endif ! ! compute tridiagonal matrix elements for momentum @@ -503,6 +536,16 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, dvsfc(i) = dvsfc(i) + tem * vtend enddo enddo + if (ldiag3d .and. .not. gen_tend) then + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k)) + vtend = (a2(i,k)-v1(i,k)) + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend + enddo + enddo + endif ! if (ntke > 0) then ! solve tridiagonal problem for momentum and tke ! diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index e8da8478d..197e50ec4 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -461,6 +461,76 @@ kind = kind_phys intent = in optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[dt3dt_PBL] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_PBL] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[do3dt_PBL] + standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL + long_name = cumulative change in ozone mixing ratio due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gen_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 06939031fbb138a44e34be54d02c94aad27adc09 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 19 Aug 2020 14:07:33 -0600 Subject: [PATCH 66/97] change horizontal_dimension to horizontal_loop_extent for PBL tendency variables --- physics/module_MYJPBL_wrapper.meta | 8 ++++---- physics/module_MYNNPBL_wrapper.meta | 10 +++++----- physics/moninedmf.meta | 10 +++++----- physics/moninshoc.meta | 10 +++++----- physics/satmedmfvdif.meta | 10 +++++----- physics/satmedmfvdifq.meta | 10 +++++----- physics/shinhongvdif.meta | 10 +++++----- physics/ysuvdif.meta | 10 +++++----- 8 files changed, 39 insertions(+), 39 deletions(-) diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index d3ae21545..1168f7f2a 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -628,7 +628,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -636,7 +636,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -644,7 +644,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -652,7 +652,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 552a95133..53a76d520 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1009,7 +1009,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1027,7 +1027,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1045,7 +1045,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1054,7 +1054,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1063,7 +1063,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index b55329717..daf5c94e4 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -527,7 +527,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -536,7 +536,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -545,7 +545,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -554,7 +554,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -563,7 +563,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 197e50ec4..003c20db0 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -473,7 +473,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -481,7 +481,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -489,7 +489,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -497,7 +497,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -505,7 +505,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 1695d56e3..bfab56403 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -547,7 +547,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -556,7 +556,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -565,7 +565,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -574,7 +574,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -583,7 +583,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 6adc7292a..0ee0a7e5d 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -599,7 +599,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -608,7 +608,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -617,7 +617,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -626,7 +626,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -635,7 +635,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 5fa62cd27..5c8ee992d 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -447,7 +447,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -455,7 +455,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -463,7 +463,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -471,7 +471,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -479,7 +479,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 29996c6fb..ca9327b3d 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -465,7 +465,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -473,7 +473,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -481,7 +481,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -489,7 +489,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -497,7 +497,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout From fd8304a9d467ef17fb334d55f5a961b8f61e3c0c Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 19 Aug 2020 17:22:03 -0600 Subject: [PATCH 67/97] fix bug in cu_gf_driver tendencies --- physics/cu_gf_driver.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 5c43709d1..150f9f6c0 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -868,11 +868,13 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & if(ishallow_g3.eq.1 .and. .not.flag_for_scnv_generic_tend) then do k=kts,ktf do i=its,itf - du3dt_SCNV(i,k) = du3dt_SCNV(i,k) + outus(i,k) * dt - dv3dt_SCNV(i,k) = dv3dt_SCNV(i,k) + outvs(i,k) * dt - dt3dt_SCNV(i,k) = dt3dt_SCNV(i,k) + outts(i,k) * dt + du3dt_SCNV(i,k) = du3dt_SCNV(i,k) + cutens(i)*outus(i,k) * dt + dv3dt_SCNV(i,k) = dv3dt_SCNV(i,k) + cutens(i)*outvs(i,k) * dt + dt3dt_SCNV(i,k) = dt3dt_SCNV(i,k) + cutens(i)*outts(i,k) * dt if(qdiag3d) then - dq3dt_SCNV(i,k) = dq3dt_SCNV(i,k) + outqs(i,k) * dt + tem = cutens(i)*outqs(i,k)* dt + tem = tem/(1.0_kind_phys+tem) + dq3dt_SCNV(i,k) = dq3dt_SCNV(i,k) + tem endif enddo enddo @@ -880,11 +882,13 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & if((ideep.eq.1. .or. imid_gf.eq.1) .and. .not.flag_for_dcnv_generic_tend) then do k=kts,ktf do i=its,itf - du3dt_DCNV(i,k) = du3dt_DCNV(i,k) + (outu(i,k)+outum(i,k)) * dt - dv3dt_DCNV(i,k) = dv3dt_DCNV(i,k) + (outv(i,k)+outvm(i,k)) * dt - dt3dt_DCNV(i,k) = dt3dt_DCNV(i,k) + (outt(i,k)+outtm(i,k)) * dt + du3dt_DCNV(i,k) = du3dt_DCNV(i,k) + (cuten(i)*outu(i,k)+cutenm(i)*outum(i,k)) * dt + dv3dt_DCNV(i,k) = dv3dt_DCNV(i,k) + (cuten(i)*outv(i,k)+cutenm(i)*outvm(i,k)) * dt + dt3dt_DCNV(i,k) = dt3dt_DCNV(i,k) + (cuten(i)*outt(i,k)+cutenm(i)*outtm(i,k)) * dt if(qdiag3d) then - dq3dt_DCNV(i,k) = dq3dt_DCNV(i,k) + (outq(i,k)+outqm(i,k)) * dt + tem = (cuten(i)*outq(i,k) + cutenm(i)*outqm(i,k))* dt + tem = tem/(1.0_kind_phys+tem) + dq3dt_DCNV(i,k) = dq3dt_DCNV(i,k) + tem endif enddo enddo From 8617587edb95aa097b7bbc2735990393bc6d9b90 Mon Sep 17 00:00:00 2001 From: ericaligo-NOAA <48365233+ericaligo-NOAA@users.noreply.github.com> Date: Thu, 20 Aug 2020 13:03:21 -0400 Subject: [PATCH 68/97] Diagnostic instantaneous 3D cloud fractions added. (#484) Description (Instructions: this, and all subsequent sections of text should be removed and filled in as appropriate.) Diagnostic cldfra array outputs 3D instantaneous cloud fractions. Works with WSM6, Thompson and GFDL mp schemes. No results changed. UPDATE: Provided a bug fix to GFS_restart.F90 with an if condition added in the ifdef CCPP block to test for reflectivity flag. RTs have been updated. Test run in 3-km FV3 LAM was successful and plots looked good. Issue(s) addressed ufs-community/ufs-weather-model#158 NOAA-EMC/fv3atm#154 #484 Testing How were these changes tested? Tested on hera with the SAR configuration. Evaluated fields from run with Thompson microphyics and GFDL microphysics. Full RTs performed on hera. Dependencies FV3 ccpp/physics --- physics/GFS_rrtmg_pre.F90 | 5 +++-- physics/GFS_rrtmg_pre.meta | 9 +++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index ca7695528..6dc14497a 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -32,7 +32,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input faersw1, faersw2, faersw3, & faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & - clouds7, clouds8, clouds9, cldsa, & + clouds7, clouds8, clouds9, cldsa, cldfra, & mtopa, mbota, de_lgth, alb1d, errmsg, errflg) use machine, only: kind_phys @@ -123,7 +123,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(inout) :: clouds1, & clouds2, clouds3, clouds4, clouds5 real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: clouds6, & - clouds7, clouds8, clouds9 + clouds7, clouds8, clouds9, cldfra real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota, mtopa @@ -922,6 +922,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input clouds7(i,k) = clouds(i,k,7) clouds8(i,k) = clouds(i,k,8) clouds9(i,k) = clouds(i,k,9) + cldfra(i,k) = clouds(i,k,1) enddo enddo diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index a06e718a5..9d51e708d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -529,6 +529,15 @@ kind = kind_phys intent = out optional = F +[cldfra] + standard_name = instantaneous_3d_cloud_fraction + long_name = instantaneous 3D cloud fraction for all MPs + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [mtopa] standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops From ea71b1fcb8aba590c1f57e3e90adb23fdf02fbe2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 24 Aug 2020 10:43:48 -0600 Subject: [PATCH 69/97] Update submodule pointer for RTE-RRTMGP --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 51f718adb..88a43f797 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 51f718adb36aa72bdc9dcc95b986dcbe5125e03a +Subproject commit 88a43f797ab3eb3c5c978485bd108a8386a6cdfd From e05c676744e9592688c9cc0b8f989fc6d578e735 Mon Sep 17 00:00:00 2001 From: ClaraDraper-NOAA Date: Tue, 25 Aug 2020 22:15:52 +0000 Subject: [PATCH 70/97] added missing 'intent = in' to meta files --- physics/GFS_rrtmgp_sw_pre.meta | 2 ++ physics/GFS_surface_generic.meta | 2 ++ 2 files changed, 4 insertions(+) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index b2330237b..543c56bbf 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -48,6 +48,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = real kind = kind_phys + intent = in optional = F [lndp_var_list] standard_name = variables_to_be_perturbed_for_landperts @@ -56,6 +57,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = character kind = len=3 + intent = in optional = F [lsswr] standard_name = flag_to_calc_sw diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 7ab6c0000..86b52b87c 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -275,6 +275,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = real kind = kind_phys + intent = in optional = F [lndp_var_list] standard_name = variables_to_be_perturbed_for_landperts @@ -283,6 +284,7 @@ dimensions = (number_of_land_surface_variables_perturbed) type = character kind = len=3 + intent = in optional = F [z01d] standard_name = perturbation_of_momentum_roughness_length From 427ce1edf760d80d24b8e11a154da76db16f70a9 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 27 Aug 2020 19:43:25 +0000 Subject: [PATCH 71/97] The first draft of change to mode RUC LSM soil variables initialization to the ;sm_ruc_init. Several issues: 1. soil and vegetation types needed for initialization are not assigned yet. Therefore, some parts of the code that use soil types is turned off. 2. There seems to ne inconsistency of land=true/false with the Noah smc, stc, slc variables. At this stage the limited verison of initialization code causes a crash in Thompson MP. --- physics/module_sf_ruclsm.F90 | 135 +++++++++--------- physics/sfc_drv_ruc.F90 | 242 ++++++++++++++++++++++---------- physics/sfc_drv_ruc.meta | 264 +++++++++++++++++++++++++++++++++++ 3 files changed, 492 insertions(+), 149 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 7345f2667..e02e1edb0 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -7022,8 +7022,8 @@ END SUBROUTINE SOILVEGIN !> This subroutine computes liquid and forezen soil moisture from the !! total soil moisture, and also computes soil moisture availability in !! the top soil layer. - SUBROUTINE RUCLSMINIT( debug_print, landmask, & - nzs, isltyp, ivgtyp, xice, mavail, & + SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & + nzs, isltyp, ivgtyp, mavail, & sh2o, smfr3d, tslb, smois, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -7035,35 +7035,33 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, & #endif IMPLICIT NONE LOGICAL, INTENT(IN ) :: debug_print - + LOGICAL, INTENT(IN ) :: frac_grid + LOGICAL, DIMENSION( ims:ime), INTENT(IN ) :: land, icy INTEGER, INTENT(IN ) :: & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & nzs - REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , & - INTENT(IN) :: TSLB, & - SMOIS - - REAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(IN) :: LANDMASK + REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , & + INTENT(IN) :: TSLB, & + SMOIS - INTEGER, DIMENSION( ims:ime, jms:jme ) , & - INTENT(INOUT) :: ISLTYP,IVGTYP + INTEGER, DIMENSION( ims:ime, jms:jme ) , & + INTENT(INOUT) :: ISLTYP,IVGTYP - REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , & - INTENT(INOUT) :: SMFR3D, & - SH2O + REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , & + INTENT(OUT) :: SMFR3D, & + SH2O - REAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(INOUT) :: XICE,MAVAIL + REAL, DIMENSION( ims:ime, jms:jme ) , & + INTENT(OUT) :: MAVAIL - REAL, DIMENSION ( 1:nzs ) :: SOILIQW + !-- local + REAL, DIMENSION ( 1:nzs ) :: SOILIQW -! - INTEGER :: I,J,L,itf,jtf - REAL :: RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH + INTEGER :: I,J,L,itf,jtf + REAL :: RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH INTEGER :: errflag @@ -7077,9 +7075,6 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, & errflag = 0 DO j = jts,jtf DO i = its,itf - ! land-only version - IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE - ! IF ( ISLTYP( i,j ) .LT. 0 ) THEN errflag = 1 print *, & @@ -7096,65 +7091,61 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, & DO J=jts,jtf DO I=its,itf - ! land-only version - IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE - -!--- Computation of volumetric content of ice in soil -!--- and initialize MAVAIL - if(ISLTYP(I,J) > 0) then - DQM = MAXSMC (ISLTYP(I,J)) - & - DRYSMC (ISLTYP(I,J)) - REF = REFSMC (ISLTYP(I,J)) - PSIS = - SATPSI (ISLTYP(I,J)) - QMIN = DRYSMC (ISLTYP(I,J)) - BCLH = BB (ISLTYP(I,J)) - endif + ! in Zobler classification isltyp=0 for water. Statsgo classification + ! has isltyp=14 for water + if (isltyp(i,j) == 0) isltyp(i,j)=14 + + if(land(i) ) then + !--- Computation of volumetric content of ice in soil + !--- and initialize MAVAIL + DQM = MAXSMC (ISLTYP(I,J)) - & + DRYSMC (ISLTYP(I,J)) + REF = REFSMC (ISLTYP(I,J)) + PSIS = - SATPSI (ISLTYP(I,J)) + QMIN = DRYSMC (ISLTYP(I,J)) + BCLH = BB (ISLTYP(I,J)) + + mavail(i,j) = max(0.00001,min(1.,(smois(i,1,j)-qmin)/(ref-qmin))) -! in Zobler classification isltyp=0 for water. Statsgo classification -! has isltyp=14 for water - if (isltyp(i,j) == 0) isltyp(i,j)=14 + DO L=1,NZS + !-- for land points initialize soil ice + tln=log(TSLB(i,l,j)/273.15) + + if(tln.lt.0.) then + soiliqw(l)=(dqm+qmin)*(XLMELT* & + (tslb(i,l,j)-273.15)/tslb(i,l,j)/9.81/psis) & + **(-1./bclh) + !**(-1./bclh)-qmin + soiliqw(l)=max(0.,soiliqw(l)) + soiliqw(l)=min(soiliqw(l),smois(i,l,j)) + sh2o(i,l,j)=soiliqw(l) + smfr3d(i,l,j)=(smois(i,l,j)-soiliqw(l))/RIW + + else + smfr3d(i,l,j)=0. + sh2o(i,l,j)=smois(i,l,j) + endif + ENDDO - IF(xice(i,j).gt.0.) THEN -!-- for ice + elseif(icy(i) .and. .not. frac_grid ) then + !-- ice DO L=1,NZS smfr3d(i,l,j)=1. sh2o(i,l,j)=0. mavail(i,j) = 1. ENDDO - ELSE - if(isltyp(i,j).ne.14 ) then -!-- land - mavail(i,j) = max(0.00001,min(1.,(smois(i,1,j)-qmin)/(ref-qmin))) - DO L=1,NZS -!-- for land points initialize soil ice - tln=log(TSLB(i,l,j)/273.15) - - if(tln.lt.0.) then - soiliqw(l)=(dqm+qmin)*(XLMELT* & - (tslb(i,l,j)-273.15)/tslb(i,l,j)/9.81/psis) & - **(-1./bclh) -! **(-1./bclh)-qmin - soiliqw(l)=max(0.,soiliqw(l)) - soiliqw(l)=min(soiliqw(l),smois(i,l,j)) - sh2o(i,l,j)=soiliqw(l) - smfr3d(i,l,j)=(smois(i,l,j)-soiliqw(l))/RIW - - else - smfr3d(i,l,j)=0. - sh2o(i,l,j)=smois(i,l,j) - endif - ENDDO + endif ! land - else + !else !-- for water ISLTYP=14 - DO L=1,NZS - smfr3d(i,l,j)=0. - sh2o(i,l,j)=1. - mavail(i,j) = 1. - ENDDO - endif - ENDIF + ! DO L=1,NZS + ! smfr3d(i,l,j)=0. + ! sh2o(i,l,j)=1. + ! mavail(i,j) = 1. + ! ENDDO + !endif + !ENDIF ENDDO ENDDO diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 65935ef1c..db1ad00b4 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -23,22 +23,118 @@ module lsm_ruc !! \section arg_table_lsm_ruc_init Argument Table !! \htmlinclude lsm_ruc_init.html !! - subroutine lsm_ruc_init (me, isot, ivegsrc, nlunit, & - & errmsg, errflg) + subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & + flag_restart, flag_init, & + im, lsoil_ruc, lsoil, kice, nlev, & ! in + lsm_ruc, lsm, & ! in + soiltyp, vegtype, frac_grid, land, icy, & ! in + fice, tsfc_lnd, tsfc_wat, tice, & + tg3, smc, slc, stc, & ! in + smcref2, smcwlt2, & ! inout + sh2o, smfrkeep, tslb, smois, wetness, & ! out + tsice, errmsg, errflg) implicit none +! --- in + integer, intent(in) :: me, master, isot, ivegsrc, nlunit + logical, intent(in) :: flag_restart + logical, intent(in) :: flag_init + logical, intent(in) :: frac_grid + integer, intent(in) :: im + integer, intent(in) :: lsoil_ruc + integer, intent(in) :: lsoil + integer, intent(in) :: kice + integer, intent(in) :: nlev + integer, intent(in) :: lsm_ruc, lsm + integer,dimension(im),intent(inout) :: soiltyp, vegtype + + logical, dimension(im), intent(in) :: land, icy + + real (kind=kind_phys), dimension(im), intent(in ) :: fice + real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_lnd + real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_wat + real (kind=kind_phys), dimension(im), intent(in ) :: tice + real (kind=kind_phys), dimension(im), intent(in) :: tg3 + + real (kind=kind_phys), dimension(im,lsoil), intent(in) :: smc,slc,stc + +! --- in/out: + real (kind=kind_phys), dimension(im), intent(inout) :: wetness + real (kind=kind_phys), dimension(im), intent(inout) :: smcref2, smcwlt2 + +! --- out + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(out) :: sh2o, smfrkeep + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(out) :: tslb, smois + real (kind=kind_phys), dimension(im,kice), intent(out) :: tsice - integer, intent(in) :: me, isot, ivegsrc, nlunit character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg +! --- local + integer :: ipr, i, k + logical :: debug_print + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ipr = 10 + debug_print = .true. + +!> - Call rucinit() to initialize soil/ice/water variables + + if ( debug_print) then + write (0,*) 'RUC LSM initialization' + write (0,*) 'lsoil_ruc, lsoil',lsoil_ruc, lsoil + write (0,*) 'noah soil temp',stc(:,1) + write (0,*) 'noah soil mois',smc(:,1) + write (0,*) 'noah mois(ipr)',ipr,smc(ipr,:) + write (0,*) 'soiltyp=',soiltyp(:) + write (0,*) 'vegtype=',vegtype(:) + write (0,*) 'fice=',fice(:) + write (0,*) 'tice=',tice(:) + write (0,*) 'tsfc_lnd=',tsfc_lnd(:) + write (0,*) 'tsfc_wat=',tsfc_wat(:) + write (0,*) 'tg3=',tg3(:) + write (0,*) 'land=',land(:) + write (0,*) 'icy=',icy(:) + write (0,*) 'flag_init =',flag_init + write (0,*) 'flag_restart =',flag_restart + endif + !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit) + if( .not. flag_restart) then + call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in + me, master, isot, ivegsrc, nlunit, & ! in + lsm_ruc, lsm, & ! in + frac_grid, land, icy, & ! in + soiltyp, vegtype, fice, & ! in + tsfc_lnd, tsfc_wat, tice, tg3, & ! in + smc, slc, stc, & ! in + smcref2, smcwlt2, & ! inout + sh2o, smfrkeep, tslb, smois, & ! out + wetness, errmsg, errflg) + + do i = 1, im ! i - horizontal loop + do k = 1, min(kice,lsoil_ruc) + ! - at initial time set sea ice T (tsice) + ! equal to TSLB, initialized from the Noah STC variable + tsice (i,k) = tslb(i,k) + enddo + enddo ! i + + endif ! flag_restart +!-- end of initialization + + if ( debug_print) then + write (0,*) 'ruc soil tslb',tslb(:,1) + write (0,*) 'ruc soil tsice',tsice(:,1) + write (0,*) 'ruc soil smois',smois(:,1) + write (0,*) 'ruc wetness',wetness(:) + endif + end subroutine lsm_ruc_init !! \section arg_table_lsm_ruc_finalize Argument Table @@ -303,25 +399,9 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'flag_restart =',flag_restart endif -!> - Call rucinit() at the first time step and the first interation -!! for RUC initialization,then overwrite Noah soil fields -!! with initialized RUC soil fields for output. if(flag_init .and. iter==1) then - if (debug_print) write (0,'(a,i0,a,l)') 'RUC LSM initialization, kdt = ', kdt, ', flag_restart = ', flag_restart - - call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in - isot, soiltyp, vegtype, fice, & ! in - land, tskin, tskin_wat, tg3, & ! in - smc, slc, stc, & ! in - smcref2, smcwlt2, & ! inout - lsm_ruc, lsm, & ! in - zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out - me, master, errmsg, errflg) - xlai = 0. - endif ! flag_init=.true.,iter=1 -!-- end of initialization ims = 1 its = 1 @@ -692,7 +772,7 @@ subroutine lsm_ruc_run & ! inputs z0(i,j) = zorl(i)/100. znt(i,j) = zorl(i)/100. - if(debug_print) then + !if(debug_print) then if(me==0 .and. i==ipr) then write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j write (0,*)'stsoil = ',stsoil(i,:,j), i,j @@ -788,7 +868,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'shdmax1d(i,j) =',i,j,shdmax1d(i,j) write (0,*)'rdlai2d =',rdlai2d endif - endif + !endif !> - Call RUC LSM lsmruc(). call lsmruc( delt, flag_init, flag_restart, kdt, iter, nsoil, & @@ -825,7 +905,9 @@ subroutine lsm_ruc_run & ! inputs & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte ) - if(debug_print) then + !if(debug_print) then + if(me==0.and.i==ipr) then + write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) write (0,*)'after sncovr(i,j) =',i,j,sncovr(i,j) @@ -860,6 +942,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'after acsn(i,j) =',i,j,acsn(i,j) write (0,*)'after snomlt(i,j) =',i,j,snomlt(i,j) endif + !endif !> - RUC LSM: prepare variables for return to parent model and unit conversion. @@ -871,16 +954,6 @@ subroutine lsm_ruc_run & ! inputs !!\n \a runoff2 - subsurface runoff (\f$m s^{-1}\f$), drainage out bottom !!\n \a snoh - phase-change heat flux from snowmelt (w m-2) ! - if(debug_print) then - !if(me==0.and.i==ipr) then - write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j - write (0,*)'stsoil = ',stsoil(i,:,j), i,j - write (0,*)'soilt = ',soilt(i,j), i,j - write (0,*)'wet = ',wet(i,j), i,j - write (0,*)'soilt1 = ',soilt1(i,j), i,j - write (0,*)'rhosnfr = ',rhosnfr(i,j), i,j - !endif - endif ! Interstitial evap(i) = qfx(i,j) / rho(i) ! kinematic @@ -1035,14 +1108,16 @@ end subroutine lsm_ruc_run !>\ingroup lsm_ruc_group !! This subroutine contains RUC LSM initialization. - subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in - isot, soiltyp, vegtype, fice, & ! in - land, tsurf, tsurf_wat, & ! in - tg3, smc, slc, stc, & ! in - smcref2, smcwlt2, & ! inout - lsm_ruc, lsm, & ! in - zs, sh2o, smfrkeep, tslb, smois, & ! out - wetness, me, master, errmsg, errflg) + subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in + me, master, isot, ivegsrc, nlunit, & ! in + lsm_ruc, lsm, & ! in + frac_grid, land, icy, & ! in + soiltyp, vegtype, fice, & ! in + tskin_lnd, tskin_wat, tice, tg3, & ! !in + smc, slc, stc, & ! in + smcref2, smcwlt2, & ! inout + sh2o, smfrkeep, tslb, smois, & ! out + wetness, errmsg, errflg) implicit none @@ -1050,11 +1125,13 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, intent(in ) :: lsm integer, intent(in ) :: lsm_ruc integer, intent(in ) :: isot + integer, intent(in ) :: ivegsrc, nlunit integer, intent(in ) :: im, nlev integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil - logical, dimension(im), intent(in ) :: land - real (kind=kind_phys), dimension(im), intent(in ) :: tsurf, tsurf_wat + logical, intent(in ) :: frac_grid + logical, dimension(im), intent(in ) :: land, icy + real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat, tice real (kind=kind_phys), dimension(im), intent(inout) :: smcref2 real (kind=kind_phys), dimension(im), intent(inout) :: smcwlt2 real (kind=kind_phys), dimension(im), intent(in ) :: tg3 @@ -1065,14 +1142,12 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, dimension(im), intent(inout) :: soiltyp integer, dimension(im), intent(inout) :: vegtype real (kind=kind_phys), dimension(im), intent(inout) :: wetness - real (kind=kind_phys), dimension(im), intent(inout) :: fice + real (kind=kind_phys), dimension(im), intent(in ) :: fice real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smois! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb ! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: sh2o ! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smfrkeep ! ruc - real (kind=kind_phys), dimension(1:lsoil_ruc), intent (out) :: zs - integer, intent(in ) :: me integer, intent(in ) :: master character(len=*), intent(out) :: errmsg @@ -1085,6 +1160,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer :: flag_soil_layers, flag_soil_levels, flag_sst real (kind=kind_phys), dimension(1:lsoil_ruc) :: factorsm + real (kind=kind_phys), dimension(1:lsoil_ruc) :: zs integer , dimension( 1:im , 1:1 ) :: ivgtyp integer , dimension( 1:im , 1:1) :: isltyp @@ -1175,8 +1251,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in flag_soil_levels = 1 ! =1 for input from RUC LSM else ! for Noah input set smadj and swi_init to .true. - smadj = .true. - swi_init = .true. + smadj = .false. + swi_init = .false. flag_soil_layers = 1 ! =1 for input from the Noah LSM flag_soil_levels = 0 ! =1 for input from RUC LSM endif @@ -1198,25 +1274,29 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in endif - if(debug_print) then + !if(debug_print) then write (0,*)'smc(ipr,:) ==', ipr, smc(ipr,:) write (0,*)'stc(ipr,:) ==', ipr, stc(ipr,:) - write (0,*)'vegtype(ipr) ==', ipr, vegtype(ipr) - write (0,*)'soiltyp(ipr) ==', ipr, soiltyp(ipr) + !write (0,*)'vegtype(ipr) ==', ipr, vegtype(ipr) + !write (0,*)'soiltyp(ipr) ==', ipr, soiltyp(ipr) + write (0,*)'tskin_lnd(:)=',tskin_lnd(:) + write (0,*)'tskin_wat(:)=',tskin_wat(:) write (0,*)'its,ite,jts,jte ',its,ite,jts,jte - endif + !endif do j=jts,jte ! do i=its,ite ! i = horizontal loop + sst(i,j) = tskin_wat(i) + tbot(i,j)= tg3(i) ! land only version if (land(i)) then - tsk(i,j) = tsurf(i) - sst(i,j) = tsurf_wat(i) - tbot(i,j)= tg3(i) + tsk(i,j) = tskin_lnd(i) ivgtyp(i,j)=vegtype(i) isltyp(i,j)=soiltyp(i) + !ivgtyp(i,j )= 12 + !isltyp(i,j) = 3 landmask(i,j)=1. xice(i,j)=0. else @@ -1236,14 +1316,13 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in st_input(i,1,j)=tsk(i,j) sm_input(i,1,j)=0. - !--- initialize smcwlt2 and smcref2 with Noah values - smcref2 (i) = REFSMCnoah(soiltyp(i)) - smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) - do k=1,lsoil st_input(i,k+1,j)=stc(i,k) ! convert volumetric soil moisture to SWI (soil wetness index) if(swi_init) then + !--- initialize smcwlt2 and smcref2 with Noah values + smcref2 (i) = REFSMCnoah(soiltyp(i)) + smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ & (smcref2(i) - smcwlt2(i)))) else @@ -1299,7 +1378,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in if(debug_print) then write (0,*)'tsk(i,j),tbot(i,j),sst(i,j),landmask(i,j)' & ,ipr,1,tsk(ipr,1),tbot(ipr,1),sst(ipr,1),landmask(ipr,1) - write (0,*)'tsurf(ipr)=',ipr,tsurf(ipr) + write (0,*)'tskin_lnd(ipr)=',ipr,tskin_lnd(ipr) write (0,*)'stc(ipr)=',ipr,stc(ipr,:) write (0,*)'smc(ipr)=',ipr,smc(ipr,:) write (0,*)'soilt(1,:,ipr)',ipr,soiltemp(ipr,:,1) @@ -1390,29 +1469,34 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! Initialize liquid and frozen soil moisture from total soil moisture ! and soil temperature, and also soil moisture availability in the top ! layer - call ruclsminit( debug_print, landmask, & - lsoil_ruc, isltyp, ivgtyp, xice, mavail, & - soilh2o, smfr, soiltemp, soilm, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + !call ruclsminit( debug_print, frac_grid, land, icy, & + ! lsoil_ruc, isltyp, ivgtyp, mavail, & + ! soilh2o, smfr, soiltemp, soilm, & + ! ims,ime, jms,jme, kms,kme, & + ! its,ite, jts,jte, kts,kte ) do j=jts,jte do i=its,ite - if (land(i)) then - wetness(i) = mavail(i,j) - do k = 1, lsoil_ruc - smois(i,k) = soilm(i,k,j) - tslb(i,k) = soiltemp(i,k,j) - sh2o(i,k) = soilh2o(i,k,j) - smfrkeep(i,k) = smfr(i,k,j) - enddo - endif ! land(i) + if (land(i)) then + wetness(i) = soilm(i,1,j)/0.5 + !wetness(i) = mavail(i,j) + do k = 1, lsoil_ruc + smois(i,k) = soilm(i,k,j) + tslb(i,k) = soiltemp(i,k,j) + sh2o(i,k) = soilm(i,k,j) + smfrkeep(i,k) = soilm(i,k,j) + !sh2o(i,k) = soilh2o(i,k,j) + !smfrkeep(i,k) = smfr(i,k,j) + enddo + endif ! land(i) enddo enddo ! For non-land points, set RUC LSM fields to input (Noah or RUC) fields + if (.not. frac_grid) then do i=1,im if (.not.land(i)) then + wetness (i) = 1. do k=1,min(lsoil,lsoil_ruc) smois(i,k) = smc(i,k) tslb(i,k) = stc(i,k) @@ -1420,12 +1504,16 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in enddo endif enddo + endif ! frac_grid - if(debug_print) then + !if(debug_print) then + do i=1,im write (0,*)'End of RUC LSM initialization' - write (0,*)'tslb(ipr)=',ipr,tslb(ipr,:) - write (0,*)'smois(ipr)=',ipr,smois(ipr,:) - endif ! debug_print + write (0,*)'tslb(i)=',i,land(i),icy(i),tslb(i,:) + write (0,*)'smois(i)=',i,land(i),icy(i),smois(i,:) + write (0,*)'wetness(i)=',i,land(i),icy(i),wetness(i) + enddo + !endif ! debug_print end subroutine rucinit diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 4721418d3..730bcd8c0 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -9,6 +9,14 @@ type = integer intent = in optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [isot] standard_name = soil_type_dataset_choice long_name = soil type dataset choice @@ -33,6 +41,262 @@ type = integer intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil_ruc] + standard_name = soil_vertical_dimension_for_land_surface_model + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_lnd] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_wat] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea ice surface skin temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sh2o] + standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model + long_name = volume fraction of unfrozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = out + optional = F +[smfrkeep] + standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model + long_name = volume fraction of frozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = out + optional = F +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = out + optional = F +[smois] + standard_name = volume_fraction_of_soil_moisture_for_land_surface_model + long_name = volumetric fraction of soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = out + optional = F +[wetness] + standard_name = normalized_soil_wetness_for_land_surface_model + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From c85072fb3484e94d22c8f3fd124b827e8040bd56 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 29 Aug 2020 16:36:23 -0600 Subject: [PATCH 72/97] physics/cires_ugwp.F90: fix bug in call to gwdps_run --- physics/cires_ugwp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index df0116cd0..f24ae39ae 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -261,7 +261,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & - ugrs, vgrs, tgrs, qgrs, & + ugrs, vgrs, tgrs, qgrs(:,:,1), & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & elvmax, dusfcg, dvsfcg, & From 5bf8978f02d9672e3776106a6bfdcf8f3fb1fcb9 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 31 Aug 2020 17:57:23 +0000 Subject: [PATCH 73/97] A typo is corrected --- physics/sfcsub.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index a78ac650f..3ceded5bc 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -384,7 +384,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & parameter(snwmin=5.0,snwmax=100.) real (kind=kind_io8), parameter :: ten=10.0, one=1.0 ! -! coeficients of blending forecast and interpolated clim +! coefficients of blending forecast and interpolated clim ! (or analyzed) fields over sea or land(l) (not for clouds) !tgs -- important ! 1.0 = use of forecast From ff2d8c2298265d32153979f0a5757500f481b230 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 31 Aug 2020 22:16:42 +0000 Subject: [PATCH 74/97] Added index k to printed out names of variables at K soil level. --- physics/sfcsub.F | 45 ++++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 3ceded5bc..ade25055b 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -581,6 +581,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & character*500 fndclm,fndanl ! logical lanom + character(len=10) :: message ! namelist/namsfc/fnglac,fnmxic, @@ -1240,7 +1241,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getsmc(wetclm,len,lsoil,smcclm,me) endif do k=1,lsoil - call qcmxmn('smc ',smcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),smcclm(1,k),sliclm,snoclm,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1250,7 +1251,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif do k=1,lsoil - call qcmxmn('stc ',stcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),stcclm(1,k),sliclm,snoclm,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1314,8 +1315,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('snoclm',snoclm,sliclm,snoclm,len) call monitr('scvclm',scvclm,sliclm,snoclm,len) do k=1,lsoil - call monitr('smcclm1',smcclm(1,k),sliclm,snoclm,len) - call monitr('stcclm1',stcclm(1,k),sliclm,snoclm,len) + call monitr(message('smcclm',k),smcclm(1,k),sliclm,snoclm,len) + call monitr(message('stcclm',k),stcclm(1,k),sliclm,snoclm,len) enddo call monitr('tg3clm',tg3clm,sliclm,snoclm,len) call monitr('zorclm',zorclm,sliclm,snoclm,len) @@ -1610,7 +1611,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif !-- soil moisture do k=1,lsoil - call qcmxmn('smca ',smcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('smca',k),smcanl(1,1),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1620,7 +1621,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif do k=1,lsoil - call qcmxmn('stca ',stcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('stca',k),stcanl(1,1),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1671,8 +1672,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('snoanl',snoanl,slianl,snoanl,len) call monitr('scvanl',scvanl,slianl,snoanl,len) do k=1,lsoil - call monitr('smcanl',smcanl(1,k),slianl,snoanl,len) - call monitr('stcanl',stcanl(1,k),slianl,snoanl,len) + call monitr(message('smcanl',k),smcanl(1,k),slianl,snoanl,len) + call monitr(message('stcanl',k),stcanl(1,k),slianl,snoanl,len) enddo call monitr('tg3anl',tg3anl,slianl,snoanl,len) call monitr('zoranl',zoranl,slianl,snoanl,len) @@ -1844,14 +1845,14 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & rla,rlo,len,kqcm,percrit,lgchek,me) !-- soil moisture forecast do k=1,lsoil - call qcmxmn('smcf ',smcfcs(1,k),slifcs,snofcs,icefl1, + call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs,snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo !-- soil temperature forecast do k=1,lsoil - call qcmxmn('stcf ',stcfcs(1,k),slifcs,snofcs,icefl1, + call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1902,8 +1903,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('aisfcs',aisfcs,slifcs,snofcs,len) call monitr('snofcs',snofcs,slifcs,snofcs,len) do k=1,lsoil - call monitr('smcfcs',smcfcs(1,k),slifcs,snofcs,len) - call monitr('stcfcs',stcfcs(1,k),slifcs,snofcs,len) + call monitr(message('smcfcs',k),smcfcs(1,k),slifcs,snofcs,len) + call monitr(message('stcfcs',k),stcfcs(1,k),slifcs,snofcs,len) enddo call monitr('tg3fcs',tg3fcs,slifcs,snofcs,len) call monitr('zorfcs',zorfcs,slifcs,snofcs,len) @@ -2048,13 +2049,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif do k=1,lsoil - call qcmxmn('stcm ',stcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('stcm',k),stcanl(1,k),slianl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo do k=1,lsoil - call qcmxmn('smcm ',smcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('smcm',k),smcanl(1,k),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -2142,7 +2143,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('aisanl',aisanl,slianl,snoanl,len) call monitr('snoanl',snoanl,slianl,snoanl,len) do k=1,lsoil - call monitr('smcanl',smcanl(1,k),slianl,snoanl,len) + call monitr(message('smcanl',k),smcanl(1,k),slianl,snoanl,len) call monitr('stcanl',stcanl(1,k),slianl,snoanl,len) enddo call monitr('tg3anl',tg3anl,slianl,snoanl,len) @@ -2221,8 +2222,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call monitr('aisdif',aisfcs,slianl,snoanl,len) call monitr('snodif',snofcs,slianl,snoanl,len) do k=1,lsoil - call monitr('smcanl',smcfcs(1,k),slianl,snoanl,len) - call monitr('stcanl',stcfcs(1,k),slianl,snoanl,len) + call monitr(message('smcanl',k),smcfcs(1,k),slianl,snoanl,len) + call monitr('stcanl(k)',stcfcs(1,k),slianl,snoanl,len) enddo call monitr('tg3dif',tg3fcs,slianl,snoanl,len) call monitr('zordif',zorfcs,slianl,snoanl,len) @@ -8605,4 +8606,14 @@ subroutine snodpth2(glacir,snwmax,snoanl, len, me) enddo return end + function message(prefix,index) + implicit none + character(len=*), intent(in) :: prefix + integer, intent(in) :: index + character(len=10) :: message + ! + ! probably need to implement a check that len(prefix) + '-' + length of + ! string representation of index <= len(message) + write(message,fmt='(a,a,i0)') trim(prefix), '-', index + end function message !>@} From 98e378f0f7f50a3a72cf9eb4ed4c7085de8cccbb Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 1 Sep 2020 00:09:46 +0000 Subject: [PATCH 75/97] Removed the message definition. --- physics/rte-rrtmgp | 2 +- physics/sfcsub.F | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 6ee0b62c1..7dfff2025 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7 +Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 diff --git a/physics/sfcsub.F b/physics/sfcsub.F index ade25055b..41110c7c5 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -581,7 +581,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & character*500 fndclm,fndanl ! logical lanom - character(len=10) :: message ! namelist/namsfc/fnglac,fnmxic, From e2d663f3cd1c4cc81b094aceadddf563793f20d9 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 1 Sep 2020 07:31:33 -0600 Subject: [PATCH 76/97] Number of threads used in sfcsub.F is now coming in via the argument list --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- physics/GFS_phys_time_vary.fv3.meta | 2 +- physics/gcycle.F90 | 9 +++---- physics/num_parthds.F | 23 ----------------- physics/sfcsub.F | 40 +++++++++++++---------------- 5 files changed, 24 insertions(+), 52 deletions(-) delete mode 100644 physics/num_parthds.F diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index bed8e14e1..3c894b777 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -468,7 +468,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs if (Model%nscyc > 0) then if (mod(Model%kdt,Model%nscyc) == 1) THEN - call gcycle (nblks, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) + call gcycle (nblks, nthrds, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) endif endif diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index bcd4112c2..72a7ce207 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,num_parthds.F,ozinterp.f90,ozne_def.f,sfcsub.F + dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 56d774afd..8b3555826 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -5,8 +5,7 @@ !>\ingroup mod_GFS_phys_time_vary !! This subroutine repopulates specific time-varying surface properties for !! atmospheric forecast runs. -# 1 "physics/gcycle.F90" - SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) + SUBROUTINE GCYCLE (nblks, nthrds, Model, Grid, Sfcprop, Cldprop) ! ! USE MACHINE, only: kind_phys @@ -15,7 +14,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) GFS_sfcprop_type, GFS_cldprop_type implicit none - integer, intent(in) :: nblks + integer, intent(in) :: nblks, nthrds type(GFS_control_type), intent(in) :: Model type(GFS_grid_type), intent(in) :: Grid(nblks) type(GFS_sfcprop_type), intent(inout) :: Sfcprop(nblks) @@ -194,8 +193,8 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) SNOFCS, ZORFCS, ALBFC1, TG3FCS, CNPFCS, & SMCFC1, STCFC1, SLIFCS, AISFCS, & VEGFCS, VETFCS, SOTFCS, ALFFC1, CVFCS, & - CVBFCS, CVTFCS, Model%me, Model%nlunit, & - size(Model%input_nml_file), & + CVBFCS, CVTFCS, Model%me, nthrds, & + Model%nlunit, size(Model%input_nml_file), & Model%input_nml_file, & lake, Model%min_lakeice, Model%min_seaice, & Model%ialb, Model%isot, Model%ivegsrc, & diff --git a/physics/num_parthds.F b/physics/num_parthds.F deleted file mode 100644 index 922ae4a4f..000000000 --- a/physics/num_parthds.F +++ /dev/null @@ -1,23 +0,0 @@ - function num_parthds() -#ifdef _OPENMP -#include -!$OMP PARALLEL - num_parthds=omp_get_num_threads() -!$OMP END PARALLEL -#else -! num_parthds=8 - num_parthds=1 -#endif - return - end - -!GFDL function num_parthds() -!GFDL integer:: number_of_openMP_threads -!GFDL character(2) :: omp_threads -!GFDL integer :: stat -!GFDL call get_environment_variable("OMP_NUM_THREADS",omp_threads) -!GFDL read(omp_threads,*,iostat=stat)number_of_openMP_threads -!GFDL num_parthds = number_of_openMP_threads -!GFDL return -!GFDL end - diff --git a/physics/sfcsub.F b/physics/sfcsub.F index a2d846aee..6984602bc 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -35,6 +35,7 @@ module sfccyc_module integer, parameter :: xdata=5000, ydata=2500, mdata=xdata*ydata integer :: veg_type_landice integer :: soil_type_landice + integer :: num_threads ! end module sfccyc_module @@ -67,7 +68,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs & &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs & &, vegfcs,vetfcs,sotfcs,alffcs & - &, cvfcs,cvbfcs,cvtfcs,me,nlunit & + &, cvfcs,cvbfcs,cvtfcs,me,nthrds,nlunit & &, sz_nml,input_nml_file & &, lake, min_lakeice, min_seaice & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) @@ -76,7 +77,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & use sfccyc_module implicit none character(len=*), intent(in) :: tile_num_ch - integer, intent(in) :: i_index(len), j_index(len) + integer, intent(in) :: i_index(len), j_index(len), & + & me, nthrds logical, intent(in) :: use_ufo, nst_anl logical, intent(in) :: lake(len) real (kind=kind_io8), intent(in) :: min_lakeice, min_seaice @@ -156,13 +158,11 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, & & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, & & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, & - & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb & + & icsnos,irttg3,kqcm,nlunit,sz_nml,ialb & &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc logical gausm, deads, qcmsk, znlst, monclm, monanl, & & monfcs, monmer, mondif, landice character(len=*), intent(in) :: input_nml_file(sz_nml) - - integer num_parthds ! !> This is a limited point version of surface program. !! @@ -760,6 +760,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, imsk, jmsk, slmskh, blnmsk, bltmsk &, glacir, amxice, tsfcl0 &, caisl, caiss, cvegs +! Set number of threads num_threads in sfccyc_module for later use +! to the value received from the calling routine (nthrds) + num_threads = nthrds ! lprnt = .false. iprnt = 1 @@ -3083,6 +3086,7 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& & gauout,len,lmask,rslmsk,slmask & &, outlat, outlon,me) use machine , only : kind_io8,kind_io4 + use sfccyc_module , only : num_threads implicit none real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, & & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, & @@ -3106,15 +3110,12 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& logical lmask ! logical first - integer num_threads data first /.true./ - save num_threads, first + save first ! integer len_thread_m, len_thread, i1_t, i2_t - integer num_parthds ! if (first) then - num_threads = num_parthds() first = .false. if (.not. allocated(imxnx)) allocate (imxnx(num_threads)) endif @@ -4714,7 +4715,8 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & & irtvmn,irtvmx,irtslp,irtabs, & & irtvet,irtsot,irtalf, landice, me) use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : veg_type_landice, soil_type_landice + use sfccyc_module, only : veg_type_landice, soil_type_landice, & + & num_threads implicit none integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, & & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, & @@ -4766,15 +4768,12 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), & & qstcl(lsoil), qstcs(lsoil) logical first - integer num_threads data first /.true./ - save num_threads, first + save first ! integer len_thread_m, i1_t, i2_t, it - integer num_parthds ! if (first) then - num_threads = num_parthds() first = .false. endif ! @@ -5426,6 +5425,7 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & & rla,rlo,len,mode,percrit,lgchek,me) ! use machine , only : kind_io8,kind_io4 + use sfccyc_module , only : num_threads implicit none integer, intent(in) :: len, mode, me real (kind=kind_io8), intent(in) :: fldimx,fldimn,fldjmx,fldomn, & @@ -5439,18 +5439,16 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & logical lgchek ! logical first - integer num_threads real (kind=kind_io8) permax, per data first /.true./ - save num_threads, first + save first ! - integer :: len_thread_m, i1_t, i2_t, it, num_parthds, & + integer :: len_thread_m, i1_t, i2_t, it, & & kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,kminj, & & ij,nprt,kmaxs,kmins,i integer :: islimsk(len), iwk(len) ! if (first) then - num_threads = num_parthds() first = .false. endif do it=1,len @@ -6656,6 +6654,7 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & & wlon,rnlat,rlnout,rltout,gaus,blno, blto) use machine , only : kind_io8,kind_io4 + use sfccyc_module , only : num_threads implicit none integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, & & j,iret @@ -6681,15 +6680,12 @@ subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & ! ! logical first - integer num_threads data first /.true./ - save num_threads, first + save first ! integer len_thread_m, j1_t, j2_t, it - integer num_parthds ! if (first) then - num_threads = num_parthds() first = .false. endif ! From 096ce3acbc0469d9f6d53f3bfac91763c533d44c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 1 Sep 2020 09:35:19 -0600 Subject: [PATCH 77/97] Update GFS_debug.F90 to prepare for further debugging capabilities, add more inline documentation --- physics/GFS_debug.F90 | 1763 +++++++++++++++++++++++++---------------- 1 file changed, 1086 insertions(+), 677 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index aba480382..e889d94df 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -1,37 +1,313 @@ !> \file GFS_debug.F90 - module GFS_diagtoscreen - - private - public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize - - public print_my_stuff, chksum_int, chksum_real, print_var +!! +!! This is the place to switch between different debug outputs. +!! - The default behavior for Intel (or any compiler other than GNU) +!! is to print mininmum, maximum and 32-bit Adler checksum for arrays. +!! - The default behavior for GNU is to mininmum, maximum and +!! mean value of arrays, because calculating the checksum leads +!! to segmentation faults with gfortran (bug in malloc?). +!! - If none of the #define preprocessor statements is used, +!! arrays are printed in full (this is often unpractical). +!! - All output to stdout/stderr from these routines are prefixed +!! with 'XXX: ' so that they can be easily removed from the log files +!! using "grep -ve 'XXX: ' ..." if needed. +!! - Only one #define statement can be active at any time +!! +!! Available options for debug output: +!! +!! #define PRINT_SUM: print mininmum, maximum and mean value of arrays +!! +!! #define PRINT_CHKSUM: mininmum, maximum and 32-bit Adler checksum for arrays +!! -! Calculating the checksum leads to segmentation faults with gfortran (bug in malloc?), -! thus print the sum of the array instead of the checksum. #ifdef __GFORTRAN__ #define PRINT_SUM #else #define PRINT_CHKSUM #endif +!! +!! +!! + + module print_var_chksum + + use machine, only: kind_phys + + implicit none + + private + + public chksum_int, chksum_real, print_var + interface print_var module procedure print_logic_0d module procedure print_logic_1d module procedure print_int_0d module procedure print_int_1d + module procedure print_int_2d module procedure print_real_0d module procedure print_real_1d module procedure print_real_2d module procedure print_real_3d + module procedure print_real_4d end interface - integer, parameter :: ISTART = 1 - integer, parameter :: IEND = 9999999 + contains + + subroutine print_logic_0d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + logical, intent(in) :: var + + write(0,'(2a,3i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, var + + end subroutine print_logic_0d + + subroutine print_logic_1d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + logical, intent(in) :: var(:) + + integer :: i + +#ifdef PRINT_SUM + write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) +#else + do i=lbound(var,1),ubound(var,1) + write(0,'(2a,3i6,i6,2e16.7,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, lat_d(i), lon_d(i), var(i) + end do +#endif + + end subroutine print_logic_1d + + subroutine print_int_0d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + integer, intent(in) :: var + + write(0,'(2a,3i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, var + + end subroutine print_int_0d + + subroutine print_int_1d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + integer, intent(in) :: var(:) + + integer :: i + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_int(size(var),var), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + write(0,'(2a,3i6,i6,2e16.7,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, lat_d(i), lon_d(i), var(i) + end do +#endif + + end subroutine print_int_1d + + subroutine print_int_2d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + integer, intent(in) :: var(:,:) + + integer :: i, k + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_int(size(var),var), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + do k=lbound(var,2),ubound(var,2) + write(0,'(2a,3i6,2i6,2e16.7,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, lat_d(i), lon_d(i), var(i,k) + end do + end do +#endif + + end subroutine print_int_2d + + subroutine print_real_0d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: var + + write(0,'(2a,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, var + + end subroutine print_real_0d + + subroutine print_real_1d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: var(:) + + integer :: i + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),var), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + write(0,'(2a,3i6,i6,2e16.7,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, lat_d(i), lon_d(i), var(i) + end do +#endif + + end subroutine print_real_1d + + subroutine print_real_2d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: var(:,:) + + integer :: k, i + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + do k=lbound(var,2),ubound(var,2) + write(0,'(2a,3i6,2i6,2e16.7,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, lat_d(i), lon_d(i), var(i,k) + end do + end do +#endif + + end subroutine print_real_2d + + subroutine print_real_3d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: var(:,:,:) + + integer :: k, i, l + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + do k=lbound(var,2),ubound(var,2) + do l=lbound(var,3),ubound(var,3) + write(0,'(2a,3i6,3i6,2e16.7,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, l, lat_d(i), lon_d(i), var(i,k,l) + end do + end do + end do +#endif + + end subroutine print_real_3d + + subroutine print_real_4d(mpirank, omprank, blkno, lat_d, lon_d, name, var) + + integer, intent(in) :: mpirank, omprank, blkno + real(kind_phys), intent(in) :: lat_d(:), lon_d(:) + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: var(:,:,:,:) + + integer :: k, i, l, m + +#ifdef PRINT_SUM + write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) +#elif defined(PRINT_CHKSUM) + write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var) +#else + do i=lbound(var,1),ubound(var,1) + do k=lbound(var,2),ubound(var,2) + do l=lbound(var,3),ubound(var,3) + do m=lbound(var,4),ubound(var,4) + write(0,'(2a,3i6,4i6,2e16.7,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, l, m, lat_d(i), lon_d(i), var(i,k,l,m) + end do + end do + end do + end do +#endif + + end subroutine print_real_4d + + function chksum_int(N, var) result(hash) + + integer, intent(in) :: N + integer, dimension(1:N), intent(in) :: var + integer*8, dimension(1:N) :: int_var + integer*8 :: a, b, i, hash + integer*8, parameter :: mod_adler=65521 + + a=1 + b=0 + i=1 + hash = 0 + int_var = TRANSFER(var, a, N) + + do i= 1, N + a = MOD(a + int_var(i), mod_adler) + b = MOD(b+a, mod_adler) + end do + + hash = ior(b * 65536, a) + + end function chksum_int + + function chksum_real(N, var) result(hash) + + integer, intent(in) :: N + real(kind_phys), dimension(1:N), intent(in) :: var + integer*8, dimension(1:N) :: int_var + integer*8 :: a, b, i, hash + integer*8, parameter :: mod_adler=65521 + + a=1 + b=0 + i=1 + hash = 0 + int_var = TRANSFER(var, a, N) + + do i= 1, N + a = MOD(a + int_var(i), mod_adler) + b = MOD(b+a, mod_adler) + end do + + hash = ior(b * 65536, a) + + end function chksum_real + + end module print_var_chksum + + module GFS_diagtoscreen + + use print_var_chksum, only: print_var + + implicit none - integer, parameter :: KSTART = 1 - integer, parameter :: KEND = 9999999 + private + + public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize contains @@ -117,405 +393,407 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, do impi=0,mpisize-1 do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then - call print_var(mpirank,omprank, blkno, 'Model%kdt' , Model%kdt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Model%kdt' , Model%kdt) ! Sfcprop - call print_var(mpirank,omprank, blkno, 'Sfcprop%slmsk' , Sfcprop%slmsk) - call print_var(mpirank,omprank, blkno, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac) - call print_var(mpirank,omprank, blkno, 'Sfcprop%landfrac' , Sfcprop%landfrac) - call print_var(mpirank,omprank, blkno, 'Sfcprop%lakefrac' , Sfcprop%lakefrac) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfc' , Sfcprop%tsfc) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfco' , Sfcprop%tsfco) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfcl' , Sfcprop%tsfcl) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tisfc' , Sfcprop%tisfc) - call print_var(mpirank,omprank, blkno, 'Sfcprop%snowd' , Sfcprop%snowd) - call print_var(mpirank,omprank, blkno, 'Sfcprop%zorl' , Sfcprop%zorl) - call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo) - call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll) - call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice) - call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime) - call print_var(mpirank,omprank, blkno, 'Sfcprop%sncovr' , Sfcprop%sncovr) - call print_var(mpirank,omprank, blkno, 'Sfcprop%snoalb' , Sfcprop%snoalb) - call print_var(mpirank,omprank, blkno, 'Sfcprop%alvsf' , Sfcprop%alvsf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%alnsf' , Sfcprop%alnsf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%alvwf' , Sfcprop%alvwf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%alnwf' , Sfcprop%alnwf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%facsf' , Sfcprop%facsf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%facwf' , Sfcprop%facwf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%slope' , Sfcprop%slope) - call print_var(mpirank,omprank, blkno, 'Sfcprop%shdmin' , Sfcprop%shdmin) - call print_var(mpirank,omprank, blkno, 'Sfcprop%shdmax' , Sfcprop%shdmax) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tg3' , Sfcprop%tg3) - call print_var(mpirank,omprank, blkno, 'Sfcprop%vfrac' , Sfcprop%vfrac) - call print_var(mpirank,omprank, blkno, 'Sfcprop%vtype' , Sfcprop%vtype) - call print_var(mpirank,omprank, blkno, 'Sfcprop%stype' , Sfcprop%stype) - call print_var(mpirank,omprank, blkno, 'Sfcprop%uustar' , Sfcprop%uustar) - call print_var(mpirank,omprank, blkno, 'Sfcprop%oro' , Sfcprop%oro) - call print_var(mpirank,omprank, blkno, 'Sfcprop%oro_uf' , Sfcprop%oro_uf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%hice' , Sfcprop%hice) - call print_var(mpirank,omprank, blkno, 'Sfcprop%weasd' , Sfcprop%weasd) - call print_var(mpirank,omprank, blkno, 'Sfcprop%canopy' , Sfcprop%canopy) - call print_var(mpirank,omprank, blkno, 'Sfcprop%ffmm' , Sfcprop%ffmm) - call print_var(mpirank,omprank, blkno, 'Sfcprop%ffhh' , Sfcprop%ffhh) - call print_var(mpirank,omprank, blkno, 'Sfcprop%f10m' , Sfcprop%f10m) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tprcp' , Sfcprop%tprcp) - call print_var(mpirank,omprank, blkno, 'Sfcprop%srflag' , Sfcprop%srflag) - call print_var(mpirank,omprank, blkno, 'Sfcprop%slc' , Sfcprop%slc) - call print_var(mpirank,omprank, blkno, 'Sfcprop%smc' , Sfcprop%smc) - call print_var(mpirank,omprank, blkno, 'Sfcprop%stc' , Sfcprop%stc) - call print_var(mpirank,omprank, blkno, 'Sfcprop%t2m' , Sfcprop%t2m) - call print_var(mpirank,omprank, blkno, 'Sfcprop%q2m' , Sfcprop%q2m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%slmsk' , Sfcprop%slmsk) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%landfrac' , Sfcprop%landfrac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%lakefrac' , Sfcprop%lakefrac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsfc' , Sfcprop%tsfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsfco' , Sfcprop%tsfco) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsfcl' , Sfcprop%tsfcl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tisfc' , Sfcprop%tisfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowd' , Sfcprop%snowd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zorl' , Sfcprop%zorl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zorlo' , Sfcprop%zorlo) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zorll' , Sfcprop%zorll) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%fice' , Sfcprop%fice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%hprime' , Sfcprop%hprime) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sncovr' , Sfcprop%sncovr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snoalb' , Sfcprop%snoalb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%alvsf' , Sfcprop%alvsf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%alnsf' , Sfcprop%alnsf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%alvwf' , Sfcprop%alvwf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%alnwf' , Sfcprop%alnwf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%facsf' , Sfcprop%facsf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%facwf' , Sfcprop%facwf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%slope' , Sfcprop%slope) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%shdmin' , Sfcprop%shdmin) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%shdmax' , Sfcprop%shdmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tg3' , Sfcprop%tg3) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%vfrac' , Sfcprop%vfrac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%vtype' , Sfcprop%vtype) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%stype' , Sfcprop%stype) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%uustar' , Sfcprop%uustar) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%oro' , Sfcprop%oro) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%oro_uf' , Sfcprop%oro_uf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%hice' , Sfcprop%hice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%weasd' , Sfcprop%weasd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%canopy' , Sfcprop%canopy) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%ffmm' , Sfcprop%ffmm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%ffhh' , Sfcprop%ffhh) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%f10m' , Sfcprop%f10m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tprcp' , Sfcprop%tprcp) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%srflag' , Sfcprop%srflag) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%slc' , Sfcprop%slc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smc' , Sfcprop%smc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%stc' , Sfcprop%stc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%t2m' , Sfcprop%t2m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%q2m' , Sfcprop%q2m) if (Model%nstf_name(1)>0) then - call print_var(mpirank,omprank, blkno, 'Sfcprop%tref ', Sfcprop%tref) - call print_var(mpirank,omprank, blkno, 'Sfcprop%z_c ', Sfcprop%z_c) - call print_var(mpirank,omprank, blkno, 'Sfcprop%c_0 ', Sfcprop%c_0) - call print_var(mpirank,omprank, blkno, 'Sfcprop%c_d ', Sfcprop%c_d) - call print_var(mpirank,omprank, blkno, 'Sfcprop%w_0 ', Sfcprop%w_0) - call print_var(mpirank,omprank, blkno, 'Sfcprop%w_d ', Sfcprop%w_d) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xt ', Sfcprop%xt) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xs ', Sfcprop%xs) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xu ', Sfcprop%xu) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xv ', Sfcprop%xv) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xz ', Sfcprop%xz) - call print_var(mpirank,omprank, blkno, 'Sfcprop%zm ', Sfcprop%zm) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xtts ', Sfcprop%xtts) - call print_var(mpirank,omprank, blkno, 'Sfcprop%xzts ', Sfcprop%xzts) - call print_var(mpirank,omprank, blkno, 'Sfcprop%d_conv ', Sfcprop%d_conv) - call print_var(mpirank,omprank, blkno, 'Sfcprop%ifd ', Sfcprop%ifd) - call print_var(mpirank,omprank, blkno, 'Sfcprop%dt_cool ', Sfcprop%dt_cool) - call print_var(mpirank,omprank, blkno, 'Sfcprop%qrain ', Sfcprop%qrain) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tref ', Sfcprop%tref) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%z_c ', Sfcprop%z_c) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%c_0 ', Sfcprop%c_0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%c_d ', Sfcprop%c_d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%w_0 ', Sfcprop%w_0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%w_d ', Sfcprop%w_d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xt ', Sfcprop%xt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xs ', Sfcprop%xs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xu ', Sfcprop%xu) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xv ', Sfcprop%xv) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xz ', Sfcprop%xz) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zm ', Sfcprop%zm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xtts ', Sfcprop%xtts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%xzts ', Sfcprop%xzts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%d_conv ', Sfcprop%d_conv) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%ifd ', Sfcprop%ifd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%dt_cool ', Sfcprop%dt_cool) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qrain ', Sfcprop%qrain) end if ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then - call print_var(mpirank,omprank, blkno, 'Sfcprop%sh2o', Sfcprop%sh2o) - call print_var(mpirank,omprank, blkno, 'Sfcprop%smois', Sfcprop%smois) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tslb', Sfcprop%tslb) - call print_var(mpirank,omprank, blkno, 'Sfcprop%zs', Sfcprop%zs) - call print_var(mpirank,omprank, blkno, 'Sfcprop%clw_surf', Sfcprop%clw_surf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf) - call print_var(mpirank,omprank, blkno, 'Sfcprop%flag_frsoil', Sfcprop%flag_frsoil) - call print_var(mpirank,omprank, blkno, 'Sfcprop%rhofr', Sfcprop%rhofr) - call print_var(mpirank,omprank, blkno, 'Sfcprop%tsnow', Sfcprop%tsnow) - call print_var(mpirank,omprank, blkno, 'Sfcprop%snowfallac ', Sfcprop%snowfallac) - call print_var(mpirank,omprank, blkno, 'Sfcprop%acsnow ', Sfcprop%acsnow) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sh2o', Sfcprop%sh2o) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smois', Sfcprop%smois) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tslb', Sfcprop%tslb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zs', Sfcprop%zs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf', Sfcprop%clw_surf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%flag_frsoil', Sfcprop%flag_frsoil) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%rhofr', Sfcprop%rhofr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsnow', Sfcprop%tsnow) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac ', Sfcprop%snowfallac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%acsnow ', Sfcprop%acsnow) end if ! Radtend - call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%dnfxc', Radtend%sfcfsw(:)%dnfxc) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%upfx0', Radtend%sfcfsw(:)%upfx0) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%dnfx0', Radtend%sfcfsw(:)%dnfx0) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%upfxc', Radtend%sfcflw(:)%upfxc) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%upfx0', Radtend%sfcflw(:)%upfx0) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%dnfxc', Radtend%sfcflw(:)%dnfxc) - call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%dnfx0', Radtend%sfcflw(:)%dnfx0) - call print_var(mpirank,omprank, blkno, 'Radtend%htrsw', Radtend%htrsw) - call print_var(mpirank,omprank, blkno, 'Radtend%htrlw', Radtend%htrlw) - call print_var(mpirank,omprank, blkno, 'Radtend%sfalb', Radtend%sfalb) - call print_var(mpirank,omprank, blkno, 'Radtend%coszen', Radtend%coszen) - call print_var(mpirank,omprank, blkno, 'Radtend%tsflw', Radtend%tsflw) - call print_var(mpirank,omprank, blkno, 'Radtend%semis', Radtend%semis) - call print_var(mpirank,omprank, blkno, 'Radtend%coszdg', Radtend%coszdg) - call print_var(mpirank,omprank, blkno, 'Radtend%swhc', Radtend%swhc) - call print_var(mpirank,omprank, blkno, 'Radtend%lwhc', Radtend%lwhc) - call print_var(mpirank,omprank, blkno, 'Radtend%lwhd', Radtend%lwhd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%dnfxc', Radtend%sfcfsw(:)%dnfxc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%upfx0', Radtend%sfcfsw(:)%upfx0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%dnfx0', Radtend%sfcfsw(:)%dnfx0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcflw%upfxc', Radtend%sfcflw(:)%upfxc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcflw%upfx0', Radtend%sfcflw(:)%upfx0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcflw%dnfxc', Radtend%sfcflw(:)%dnfxc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcflw%dnfx0', Radtend%sfcflw(:)%dnfx0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%htrsw', Radtend%htrsw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%htrlw', Radtend%htrlw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfalb', Radtend%sfalb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%coszen', Radtend%coszen) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%tsflw', Radtend%tsflw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%semis', Radtend%semis) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%coszdg', Radtend%coszdg) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%swhc', Radtend%swhc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%lwhc', Radtend%lwhc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%lwhd', Radtend%lwhd) ! Tbd - call print_var(mpirank,omprank, blkno, 'Tbd%icsdsw' , Tbd%icsdsw) - call print_var(mpirank,omprank, blkno, 'Tbd%icsdlw' , Tbd%icsdlw) - call print_var(mpirank,omprank, blkno, 'Tbd%ozpl' , Tbd%ozpl) - call print_var(mpirank,omprank, blkno, 'Tbd%h2opl' , Tbd%h2opl) - call print_var(mpirank,omprank, blkno, 'Tbd%rann' , Tbd%rann) - call print_var(mpirank,omprank, blkno, 'Tbd%acv' , Tbd%acv) - call print_var(mpirank,omprank, blkno, 'Tbd%acvb' , Tbd%acvb) - call print_var(mpirank,omprank, blkno, 'Tbd%acvt' , Tbd%acvt) - call print_var(mpirank,omprank, blkno, 'Tbd%hpbl' , Tbd%hpbl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%icsdsw' , Tbd%icsdsw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%icsdlw' , Tbd%icsdlw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%ozpl' , Tbd%ozpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%h2opl' , Tbd%h2opl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%rann' , Tbd%rann) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%acv' , Tbd%acv) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%acvb' , Tbd%acvb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%acvt' , Tbd%acvt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%hpbl' , Tbd%hpbl) if (Model%do_sppt) then - call print_var(mpirank,omprank, blkno, 'Tbd%dtdtr' , Tbd%dtdtr) - call print_var(mpirank,omprank, blkno, 'Tbd%dtotprcp' , Tbd%dtotprcp) - call print_var(mpirank,omprank, blkno, 'Tbd%dcnvprcp' , Tbd%dcnvprcp) - call print_var(mpirank,omprank, blkno, 'Tbd%drain_cpl' , Tbd%drain_cpl) - call print_var(mpirank,omprank, blkno, 'Tbd%dsnow_cpl' , Tbd%dsnow_cpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dtdtr' , Tbd%dtdtr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dtotprcp' , Tbd%dtotprcp) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dcnvprcp' , Tbd%dcnvprcp) + end if + if (Model%cplflx .or. Model%cplchm) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%drain_cpl' , Tbd%drain_cpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dsnow_cpl' , Tbd%dsnow_cpl) end if if (Model%nctp > 0 .and. Model%cscnv) then - call print_var(mpirank,omprank, blkno, 'Tbd%phy_fctd' , Tbd%phy_fctd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%phy_fctd' , Tbd%phy_fctd) end if - call print_var(mpirank,omprank, blkno, 'Tbd%phy_f2d' , Tbd%phy_f2d) - call print_var(mpirank,omprank, blkno, 'Tbd%phy_f3d' , Tbd%phy_f3d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%phy_f2d' , Tbd%phy_f2d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%phy_f3d' , Tbd%phy_f3d) do n=1,size(Tbd%phy_f3d(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Tbd%phy_f3d_n' , Tbd%phy_f3d(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%phy_f3d_n' , Tbd%phy_f3d(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Tbd%in_nm' , Tbd%in_nm) - call print_var(mpirank,omprank, blkno, 'Tbd%ccn_nm' , Tbd%ccn_nm) - call print_var(mpirank,omprank, blkno, 'Tbd%aer_nm' , Tbd%aer_nm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%in_nm' , Tbd%in_nm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%ccn_nm' , Tbd%ccn_nm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aer_nm' , Tbd%aer_nm) ! Diag - !call print_var(mpirank,omprank, blkno, 'Diag%fluxr ', Diag%fluxr) + !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%fluxr ', Diag%fluxr) !do n=1,size(Diag%fluxr(1,:)) - ! call print_var(mpirank,omprank, blkno, 'Diag%fluxr_n ', Diag%fluxr(:,n)) + ! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%fluxr_n ', Diag%fluxr(:,n)) !end do - call print_var(mpirank,omprank, blkno, 'Diag%srunoff ', Diag%srunoff) - call print_var(mpirank,omprank, blkno, 'Diag%evbsa ', Diag%evbsa) - call print_var(mpirank,omprank, blkno, 'Diag%evcwa ', Diag%evcwa) - call print_var(mpirank,omprank, blkno, 'Diag%snohfa ', Diag%snohfa) - call print_var(mpirank,omprank, blkno, 'Diag%transa ', Diag%transa) - call print_var(mpirank,omprank, blkno, 'Diag%sbsnoa ', Diag%sbsnoa) - call print_var(mpirank,omprank, blkno, 'Diag%snowca ', Diag%snowca) - call print_var(mpirank,omprank, blkno, 'Diag%soilm ', Diag%soilm) - call print_var(mpirank,omprank, blkno, 'Diag%tmpmin ', Diag%tmpmin) - call print_var(mpirank,omprank, blkno, 'Diag%tmpmax ', Diag%tmpmax) - call print_var(mpirank,omprank, blkno, 'Diag%dusfc ', Diag%dusfc) - call print_var(mpirank,omprank, blkno, 'Diag%dvsfc ', Diag%dvsfc) - call print_var(mpirank,omprank, blkno, 'Diag%dtsfc ', Diag%dtsfc) - call print_var(mpirank,omprank, blkno, 'Diag%dqsfc ', Diag%dqsfc) - call print_var(mpirank,omprank, blkno, 'Diag%totprcp ', Diag%totprcp) - call print_var(mpirank,omprank, blkno, 'Diag%totice ', Diag%totice) - call print_var(mpirank,omprank, blkno, 'Diag%totsnw ', Diag%totsnw) - call print_var(mpirank,omprank, blkno, 'Diag%totgrp ', Diag%totgrp) - call print_var(mpirank,omprank, blkno, 'Diag%totprcpb ', Diag%totprcpb) - call print_var(mpirank,omprank, blkno, 'Diag%toticeb ', Diag%toticeb) - call print_var(mpirank,omprank, blkno, 'Diag%totsnwb ', Diag%totsnwb) - call print_var(mpirank,omprank, blkno, 'Diag%totgrpb ', Diag%totgrpb) - call print_var(mpirank,omprank, blkno, 'Diag%suntim ', Diag%suntim) - call print_var(mpirank,omprank, blkno, 'Diag%runoff ', Diag%runoff) - call print_var(mpirank,omprank, blkno, 'Diag%ep ', Diag%ep) - call print_var(mpirank,omprank, blkno, 'Diag%cldwrk ', Diag%cldwrk) - call print_var(mpirank,omprank, blkno, 'Diag%dugwd ', Diag%dugwd) - call print_var(mpirank,omprank, blkno, 'Diag%dvgwd ', Diag%dvgwd) - call print_var(mpirank,omprank, blkno, 'Diag%psmean ', Diag%psmean) - call print_var(mpirank,omprank, blkno, 'Diag%cnvprcp ', Diag%cnvprcp) - call print_var(mpirank,omprank, blkno, 'Diag%cnvprcpb ', Diag%cnvprcpb) - call print_var(mpirank,omprank, blkno, 'Diag%spfhmin ', Diag%spfhmin) - call print_var(mpirank,omprank, blkno, 'Diag%spfhmax ', Diag%spfhmax) - call print_var(mpirank,omprank, blkno, 'Diag%u10mmax ', Diag%u10mmax) - call print_var(mpirank,omprank, blkno, 'Diag%v10mmax ', Diag%v10mmax) - call print_var(mpirank,omprank, blkno, 'Diag%wind10mmax ', Diag%wind10mmax) - call print_var(mpirank,omprank, blkno, 'Diag%rain ', Diag%rain) - call print_var(mpirank,omprank, blkno, 'Diag%rainc ', Diag%rainc) - call print_var(mpirank,omprank, blkno, 'Diag%ice ', Diag%ice) - call print_var(mpirank,omprank, blkno, 'Diag%snow ', Diag%snow) - call print_var(mpirank,omprank, blkno, 'Diag%graupel ', Diag%graupel) - call print_var(mpirank,omprank, blkno, 'Diag%u10m ', Diag%u10m) - call print_var(mpirank,omprank, blkno, 'Diag%v10m ', Diag%v10m) - call print_var(mpirank,omprank, blkno, 'Diag%dpt2m ', Diag%dpt2m) - call print_var(mpirank,omprank, blkno, 'Diag%zlvl ', Diag%zlvl) - call print_var(mpirank,omprank, blkno, 'Diag%psurf ', Diag%psurf) - call print_var(mpirank,omprank, blkno, 'Diag%pwat ', Diag%pwat) - call print_var(mpirank,omprank, blkno, 'Diag%t1 ', Diag%t1) - call print_var(mpirank,omprank, blkno, 'Diag%q1 ', Diag%q1) - call print_var(mpirank,omprank, blkno, 'Diag%u1 ', Diag%u1) - call print_var(mpirank,omprank, blkno, 'Diag%v1 ', Diag%v1) - call print_var(mpirank,omprank, blkno, 'Diag%chh ', Diag%chh) - call print_var(mpirank,omprank, blkno, 'Diag%cmm ', Diag%cmm) - call print_var(mpirank,omprank, blkno, 'Diag%epi ', Diag%epi) - call print_var(mpirank,omprank, blkno, 'Diag%smcwlt2 ', Diag%smcwlt2) - call print_var(mpirank,omprank, blkno, 'Diag%smcref2 ', Diag%smcref2) - call print_var(mpirank,omprank, blkno, 'Diag%sr ', Diag%sr) - call print_var(mpirank,omprank, blkno, 'Diag%tdomr ', Diag%tdomr) - call print_var(mpirank,omprank, blkno, 'Diag%tdomzr ', Diag%tdomzr) - call print_var(mpirank,omprank, blkno, 'Diag%tdomip ', Diag%tdomip) - call print_var(mpirank,omprank, blkno, 'Diag%tdoms ', Diag%tdoms) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%srunoff ', Diag%srunoff) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%evbsa ', Diag%evbsa) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%evcwa ', Diag%evcwa) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%snohfa ', Diag%snohfa) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%transa ', Diag%transa) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%sbsnoa ', Diag%sbsnoa) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%snowca ', Diag%snowca) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%soilm ', Diag%soilm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tmpmin ', Diag%tmpmin) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tmpmax ', Diag%tmpmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dusfc ', Diag%dusfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvsfc ', Diag%dvsfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtsfc ', Diag%dtsfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dqsfc ', Diag%dqsfc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totprcp ', Diag%totprcp) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totice ', Diag%totice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totsnw ', Diag%totsnw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totgrp ', Diag%totgrp) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totprcpb ', Diag%totprcpb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%toticeb ', Diag%toticeb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totsnwb ', Diag%totsnwb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%totgrpb ', Diag%totgrpb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%suntim ', Diag%suntim) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%runoff ', Diag%runoff) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ep ', Diag%ep) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cldwrk ', Diag%cldwrk) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dugwd ', Diag%dugwd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvgwd ', Diag%dvgwd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%psmean ', Diag%psmean) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cnvprcp ', Diag%cnvprcp) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cnvprcpb ', Diag%cnvprcpb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%spfhmin ', Diag%spfhmin) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%spfhmax ', Diag%spfhmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%u10mmax ', Diag%u10mmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v10mmax ', Diag%v10mmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%wind10mmax ', Diag%wind10mmax) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%rain ', Diag%rain) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%rainc ', Diag%rainc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ice ', Diag%ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%snow ', Diag%snow) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%graupel ', Diag%graupel) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%u10m ', Diag%u10m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v10m ', Diag%v10m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dpt2m ', Diag%dpt2m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zlvl ', Diag%zlvl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%psurf ', Diag%psurf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%pwat ', Diag%pwat) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%t1 ', Diag%t1) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%q1 ', Diag%q1) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%u1 ', Diag%u1) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v1 ', Diag%v1) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%chh ', Diag%chh) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cmm ', Diag%cmm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%epi ', Diag%epi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcwlt2 ', Diag%smcwlt2) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcref2 ', Diag%smcref2) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%sr ', Diag%sr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tdomr ', Diag%tdomr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tdomzr ', Diag%tdomzr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tdomip ', Diag%tdomip) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%tdoms ', Diag%tdoms) ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then - call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Sfcprop%wetness) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%wet1 ', Sfcprop%wetness) else - call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Diag%wet1) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%wet1 ', Diag%wet1) end if - call print_var(mpirank,omprank, blkno, 'Diag%skebu_wts ', Diag%skebu_wts) - call print_var(mpirank,omprank, blkno, 'Diag%skebv_wts ', Diag%skebv_wts) - call print_var(mpirank,omprank, blkno, 'Diag%sppt_wts ', Diag%sppt_wts) - call print_var(mpirank,omprank, blkno, 'Diag%shum_wts ', Diag%shum_wts) - call print_var(mpirank,omprank, blkno, 'Diag%zmtnblck ', Diag%zmtnblck) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%skebu_wts ', Diag%skebu_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%skebv_wts ', Diag%skebv_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%sppt_wts ', Diag%sppt_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%shum_wts ', Diag%shum_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zmtnblck ', Diag%zmtnblck) if (Model%ldiag3d) then - call print_var(mpirank,omprank, blkno, 'Diag%du3dt ', Diag%du3dt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du3dt ', Diag%du3dt) do n=1,size(Diag%du3dt(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Diag%du3dt_n ', Diag%du3dt(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du3dt_n ', Diag%du3dt(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Diag%dv3dt ', Diag%dv3dt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv3dt ', Diag%dv3dt) do n=1,size(Diag%dv3dt(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Diag%dv3dt_n ', Diag%dv3dt(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv3dt_n ', Diag%dv3dt(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Diag%dt3dt ', Diag%dt3dt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dt3dt ', Diag%dt3dt) do n=1,size(Diag%dt3dt(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Diag%dt3dt_n ', Diag%dt3dt(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dt3dt_n ', Diag%dt3dt(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Diag%dq3dt ', Diag%dq3dt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dq3dt ', Diag%dq3dt) do n=1,size(Diag%dq3dt(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Diag%dq3dt_n ', Diag%dq3dt(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dq3dt_n ', Diag%dq3dt(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Diag%upd_mf ', Diag%upd_mf) - call print_var(mpirank,omprank, blkno, 'Diag%dwn_mf ', Diag%dwn_mf) - call print_var(mpirank,omprank, blkno, 'Diag%det_mf ', Diag%det_mf) - call print_var(mpirank,omprank, blkno, 'Diag%cldcov ', Diag%cldcov) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cldcov ', Diag%cldcov) end if if(Model%lradar) then - call print_var(mpirank,omprank, blkno, 'Diag%refl_10cm ', Diag%refl_10cm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) end if ! CCPP/MYNNPBL only if (Model%do_mynnedmf) then if (Model%bl_mynn_output .ne. 0) then - call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) - call print_var(mpirank,omprank, blkno, 'Diag%sub_thl ', Diag%sub_thl) - call print_var(mpirank,omprank, blkno, 'Diag%sub_sqv ', Diag%sub_sqv) - call print_var(mpirank,omprank, blkno, 'Diag%det_thl ', Diag%det_thl) - call print_var(mpirank,omprank, blkno, 'Diag%det_sqv ', Diag%det_sqv) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_a ', Diag%edmf_a) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_w ', Diag%edmf_w) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_qt ', Diag%edmf_qt) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_thl ', Diag%edmf_thl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_ent ', Diag%edmf_ent) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%edmf_qc ', Diag%edmf_qc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%sub_thl ', Diag%sub_thl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%sub_sqv ', Diag%sub_sqv) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_thl ', Diag%det_thl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_sqv ', Diag%det_sqv) end if - call print_var(mpirank,omprank, blkno, 'Diag%nupdraft ', Diag%nupdraft) - call print_var(mpirank,omprank, blkno, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank,omprank, blkno, 'Diag%ktop_plume ', Diag%ktop_plume) - call print_var(mpirank,omprank, blkno, 'Diag%exch_h ', Diag%exch_h) - call print_var(mpirank,omprank, blkno, 'Diag%exch_m ', Diag%exch_m) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nupdraft ', Diag%nupdraft) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxMF ', Diag%maxMF) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ktop_plume ', Diag%ktop_plume) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_h ', Diag%exch_h) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if ! Statein - call print_var(mpirank,omprank, blkno, 'Statein%phii' , Statein%phii) - call print_var(mpirank,omprank, blkno, 'Statein%prsi' , Statein%prsi) - call print_var(mpirank,omprank, blkno, 'Statein%prsik' , Statein%prsik) - call print_var(mpirank,omprank, blkno, 'Statein%phil' , Statein%phil) - call print_var(mpirank,omprank, blkno, 'Statein%prsl' , Statein%prsl) - call print_var(mpirank,omprank, blkno, 'Statein%prslk' , Statein%prslk) - call print_var(mpirank,omprank, blkno, 'Statein%pgr' , Statein%pgr) - call print_var(mpirank,omprank, blkno, 'Statein%ugrs' , Statein%ugrs) - call print_var(mpirank,omprank, blkno, 'Statein%vgrs' , Statein%vgrs) - call print_var(mpirank,omprank, blkno, 'Statein%vvl' , Statein%vvl) - call print_var(mpirank,omprank, blkno, 'Statein%tgrs' , Statein%tgrs) - call print_var(mpirank,omprank, blkno, 'Statein%qgrs' , Statein%qgrs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%phii' , Statein%phii) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%prsi' , Statein%prsi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%prsik' , Statein%prsik) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%phil' , Statein%phil) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%prsl' , Statein%prsl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%prslk' , Statein%prslk) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%pgr' , Statein%pgr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%ugrs' , Statein%ugrs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%vgrs' , Statein%vgrs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%vvl' , Statein%vvl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%tgrs' , Statein%tgrs) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%qgrs' , Statein%qgrs) do n=1,size(Statein%qgrs(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Statein%qgrs_n', Statein%qgrs(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%qgrs_n', Statein%qgrs(:,:,n)) end do - call print_var(mpirank,omprank, blkno, 'Statein%diss_est', Statein%diss_est) - call print_var(mpirank,omprank, blkno, 'Statein%smc' , Statein%smc) - call print_var(mpirank,omprank, blkno, 'Statein%stc' , Statein%stc) - call print_var(mpirank,omprank, blkno, 'Statein%slc' , Statein%slc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%diss_est', Statein%diss_est) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%smc' , Statein%smc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%stc' , Statein%stc) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%slc' , Statein%slc) ! Stateout - call print_var(mpirank,omprank, blkno, 'Stateout%gu0', Stateout%gu0) - call print_var(mpirank,omprank, blkno, 'Stateout%gv0', Stateout%gv0) - call print_var(mpirank,omprank, blkno, 'Stateout%gt0', Stateout%gt0) - call print_var(mpirank,omprank, blkno, 'Stateout%gq0', Stateout%gq0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Stateout%gu0', Stateout%gu0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Stateout%gv0', Stateout%gv0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Stateout%gt0', Stateout%gt0) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Stateout%gq0', Stateout%gq0) do n=1,size(Stateout%gq0(1,1,:)) - call print_var(mpirank,omprank, blkno, 'Stateout%gq0_n', Stateout%gq0(:,:,n)) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Stateout%gq0_n', Stateout%gq0(:,:,n)) end do ! Coupling - call print_var(mpirank,omprank, blkno, 'Coupling%nirbmdi', Coupling%nirbmdi) - call print_var(mpirank,omprank, blkno, 'Coupling%nirdfdi', Coupling%nirdfdi) - call print_var(mpirank,omprank, blkno, 'Coupling%visbmdi', Coupling%visbmdi) - call print_var(mpirank,omprank, blkno, 'Coupling%visdfdi', Coupling%visdfdi) - call print_var(mpirank,omprank, blkno, 'Coupling%nirbmui', Coupling%nirbmui) - call print_var(mpirank,omprank, blkno, 'Coupling%nirdfui', Coupling%nirdfui) - call print_var(mpirank,omprank, blkno, 'Coupling%visbmui', Coupling%visbmui) - call print_var(mpirank,omprank, blkno, 'Coupling%visdfui', Coupling%visdfui) - call print_var(mpirank,omprank, blkno, 'Coupling%sfcdsw ', Coupling%sfcdsw ) - call print_var(mpirank,omprank, blkno, 'Coupling%sfcnsw ', Coupling%sfcnsw ) - call print_var(mpirank,omprank, blkno, 'Coupling%sfcdlw ', Coupling%sfcdlw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nirbmdi', Coupling%nirbmdi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nirdfdi', Coupling%nirdfdi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%visbmdi', Coupling%visbmdi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%visdfdi', Coupling%visdfdi) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nirbmui', Coupling%nirbmui) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nirdfui', Coupling%nirdfui) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%visbmui', Coupling%visbmui) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%visdfui', Coupling%visdfui) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sfcdsw ', Coupling%sfcdsw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sfcnsw ', Coupling%sfcnsw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sfcdlw ', Coupling%sfcdlw ) if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm) then - call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) - call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rain_cpl', Coupling%rain_cpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%snow_cpl', Coupling%snow_cpl) end if ! if (Model%cplwav2atm) then -! call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) +! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) ! end if if (Model%cplflx) then - call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dtsfcin_cpl ', Coupling%dtsfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dqsfcin_cpl ', Coupling%dqsfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl ) -! call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) -! call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) -! call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) -! call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dusfc_cpl ', Coupling%dusfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvsfc_cpl ', Coupling%dvsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dtsfc_cpl ', Coupling%dtsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dqsfc_cpl ', Coupling%dqsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dlwsfc_cpl ', Coupling%dlwsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dswsfc_cpl ', Coupling%dswsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dnirbm_cpl ', Coupling%dnirbm_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dnirdf_cpl ', Coupling%dnirdf_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvisbm_cpl ', Coupling%dvisbm_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvisdf_cpl ', Coupling%dvisdf_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nlwsfc_cpl ', Coupling%nlwsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nswsfc_cpl ', Coupling%nswsfc_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nnirbm_cpl ', Coupling%nnirbm_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nnirdf_cpl ', Coupling%nnirdf_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nvisbm_cpl ', Coupling%nvisbm_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nvisdf_cpl ', Coupling%nvisdf_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dusfci_cpl ', Coupling%dusfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvsfci_cpl ', Coupling%dvsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dtsfci_cpl ', Coupling%dtsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dqsfci_cpl ', Coupling%dqsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dlwsfci_cpl ', Coupling%dlwsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dswsfci_cpl ', Coupling%dswsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dnirbmi_cpl ', Coupling%dnirbmi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dnirdfi_cpl ', Coupling%dnirdfi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvisbmi_cpl ', Coupling%dvisbmi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%dvisdfi_cpl ', Coupling%dvisdfi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nlwsfci_cpl ', Coupling%nlwsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nswsfci_cpl ', Coupling%nswsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nnirbmi_cpl ', Coupling%nnirbmi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nnirdfi_cpl ', Coupling%nnirdfi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nvisbmi_cpl ', Coupling%nvisbmi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%nvisdfi_cpl ', Coupling%nvisdfi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%t2mi_cpl ', Coupling%t2mi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%q2mi_cpl ', Coupling%q2mi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%u10mi_cpl ', Coupling%u10mi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%oro_cpl' , Coupling%oro_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfcin_cpl ', Coupling%dtsfcin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfcin_cpl ', Coupling%dqsfcin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl ) +! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) +! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) +! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) +! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfc_cpl ', Coupling%dusfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfc_cpl ', Coupling%dvsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfc_cpl ', Coupling%dtsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfc_cpl ', Coupling%dqsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dlwsfc_cpl ', Coupling%dlwsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dswsfc_cpl ', Coupling%dswsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dnirbm_cpl ', Coupling%dnirbm_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dnirdf_cpl ', Coupling%dnirdf_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvisbm_cpl ', Coupling%dvisbm_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvisdf_cpl ', Coupling%dvisdf_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nlwsfc_cpl ', Coupling%nlwsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nswsfc_cpl ', Coupling%nswsfc_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nnirbm_cpl ', Coupling%nnirbm_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nnirdf_cpl ', Coupling%nnirdf_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nvisbm_cpl ', Coupling%nvisbm_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nvisdf_cpl ', Coupling%nvisdf_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfci_cpl ', Coupling%dusfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfci_cpl ', Coupling%dvsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfci_cpl ', Coupling%dtsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfci_cpl ', Coupling%dqsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dlwsfci_cpl ', Coupling%dlwsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dswsfci_cpl ', Coupling%dswsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dnirbmi_cpl ', Coupling%dnirbmi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dnirdfi_cpl ', Coupling%dnirdfi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvisbmi_cpl ', Coupling%dvisbmi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvisdfi_cpl ', Coupling%dvisdfi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nlwsfci_cpl ', Coupling%nlwsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nswsfci_cpl ', Coupling%nswsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nnirbmi_cpl ', Coupling%nnirbmi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nnirdfi_cpl ', Coupling%nnirdfi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nvisbmi_cpl ', Coupling%nvisbmi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nvisdfi_cpl ', Coupling%nvisdfi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%t2mi_cpl ', Coupling%t2mi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%q2mi_cpl ', Coupling%q2mi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%u10mi_cpl ', Coupling%u10mi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) end if if (Model%cplchm) then - call print_var(mpirank,omprank, blkno, 'Coupling%rainc_cpl', Coupling%rainc_cpl) - call print_var(mpirank,omprank, blkno, 'Coupling%ushfsfci ', Coupling%ushfsfci ) - call print_var(mpirank,omprank, blkno, 'Coupling%dkt ', Coupling%dkt ) - call print_var(mpirank,omprank, blkno, 'Coupling%dqdti ', Coupling%dqdti ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rainc_cpl', Coupling%rainc_cpl) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ushfsfci ', Coupling%ushfsfci ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dkt ', Coupling%dkt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqdti ', Coupling%dqdti ) end if if (Model%do_sppt) then - call print_var(mpirank,omprank, blkno, 'Coupling%sppt_wts', Coupling%sppt_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sppt_wts', Coupling%sppt_wts) end if if (Model%do_shum) then - call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%shum_wts', Coupling%shum_wts) end if if (Model%do_skeb) then - call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) - call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%skebu_wts', Coupling%skebu_wts ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if - if (Model%lndp_type .NE. 0) then - call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) + if (Model%lndp_type /= 0) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sfc_wts' , Coupling%sfc_wts ) end if if (Model%do_ca) then - call print_var(mpirank,omprank, blkno, 'Coupling%ca1 ', Coupling%ca1 ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep ', Coupling%ca_deep ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb ', Coupling%ca_turb ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal ', Coupling%ca_shal ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad ', Coupling%ca_rad ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca1 ', Coupling%ca1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_deep ', Coupling%ca_deep ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_turb ', Coupling%ca_turb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_shal ', Coupling%ca_shal ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_rad ', Coupling%ca_rad ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_micro ', Coupling%ca_micro ) end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then - call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) - call print_var(mpirank,omprank, blkno, 'Coupling%nifa2d', Coupling%nifa2d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nwfa2d', Coupling%nwfa2d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nifa2d', Coupling%nifa2d) end if ! Grid - call print_var(mpirank,omprank, blkno, 'Grid%xlon ', Grid%xlon ) - call print_var(mpirank,omprank, blkno, 'Grid%xlat ', Grid%xlat ) - call print_var(mpirank,omprank, blkno, 'Grid%xlat_d', Grid%xlat_d) - call print_var(mpirank,omprank, blkno, 'Grid%sinlat', Grid%sinlat) - call print_var(mpirank,omprank, blkno, 'Grid%coslat', Grid%coslat) - call print_var(mpirank,omprank, blkno, 'Grid%area ', Grid%area ) - call print_var(mpirank,omprank, blkno, 'Grid%dx ', Grid%dx ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlon ', Grid%xlon ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlat ', Grid%xlat ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlat_d', Grid%xlat_d) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%sinlat', Grid%sinlat) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%coslat', Grid%coslat) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%area ', Grid%area ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%dx ', Grid%dx ) if (Model%ntoz > 0) then - call print_var(mpirank,omprank, blkno, 'Grid%ddy_o3 ', Grid%ddy_o3 ) - call print_var(mpirank,omprank, blkno, 'Grid%jindx1_o3', Grid%jindx1_o3) - call print_var(mpirank,omprank, blkno, 'Grid%jindx2_o3', Grid%jindx2_o3) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_o3 ', Grid%ddy_o3 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_o3', Grid%jindx1_o3) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_o3', Grid%jindx2_o3) endif if (Model%h2o_phys) then - call print_var(mpirank,omprank, blkno, 'Grid%ddy_h ', Grid%ddy_h ) - call print_var(mpirank,omprank, blkno, 'Grid%jindx1_h', Grid%jindx1_h) - call print_var(mpirank,omprank, blkno, 'Grid%jindx2_h', Grid%jindx2_h) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_h ', Grid%ddy_h ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_h', Grid%jindx1_h) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_h', Grid%jindx2_h) endif ! Model/Control ! not yet @@ -538,251 +816,15 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end subroutine GFS_diagtoscreen_run - subroutine print_logic_0d(mpirank,omprank,blkno,name,var) - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - logical, intent(in) :: var - - write(0,'(2a,3i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, var - - end subroutine print_logic_0d - - subroutine print_int_0d(mpirank,omprank,blkno,name,var) - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - integer, intent(in) :: var - - write(0,'(2a,3i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, var - - end subroutine print_int_0d - - subroutine print_logic_1d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - logical, intent(in) :: var(:) - - integer :: i - -#ifdef PRINT_SUM - write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) -#elif defined(PRINT_CHKSUM) - write(0,'(2a,3i6,2i8)') 'XXX: ', trim(name), mpirank, omprank, blkno, size(var), count(var) -#else - do i=ISTART,min(IEND,size(var(:))) - write(0,'(2a,3i6,i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i) - end do -#endif - - end subroutine print_logic_1d - - subroutine print_int_1d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - integer, intent(in) :: var(:) - - integer :: i - -#ifdef PRINT_SUM - write(0,'(2a,3i6,3i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) -#elif defined(PRINT_CHKSUM) - write(0,'(2a,3i6,i20,2i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_int(size(var),var), minval(var), maxval(var) -#else - do i=ISTART,min(IEND,size(var(:))) - write(0,'(2a,3i6,i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i) - end do -#endif - - end subroutine print_int_1d - - subroutine print_real_0d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - real(kind_phys), intent(in) :: var - - write(0,'(2a,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, var - - end subroutine print_real_0d - - subroutine print_real_1d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - real(kind_phys), intent(in) :: var(:) - - integer :: i - -#ifdef PRINT_SUM - write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) -#elif defined(PRINT_CHKSUM) - write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),var), minval(var), maxval(var) -#else - do i=ISTART,min(IEND,size(var(:))) - write(0,'(2a,3i6,i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i) - end do -#endif - - end subroutine print_real_1d - - subroutine print_real_2d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - real(kind_phys), intent(in) :: var(:,:) - - integer :: k, i - -#ifdef PRINT_SUM - write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) -#elif defined(PRINT_CHKSUM) - write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var) -#else - do i=ISTART,min(IEND,size(var(:,1))) - do k=KSTART,min(KEND,size(var(1,:))) - write(0,'(2a,3i6,2i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, var(i,k) - end do - end do -#endif - - end subroutine print_real_2d - - subroutine print_real_3d(mpirank,omprank,blkno,name,var) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: mpirank, omprank, blkno - character(len=*), intent(in) :: name - real(kind_phys), intent(in) :: var(:,:,:) - - integer :: k, i, l - -#ifdef PRINT_SUM - write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var) -#elif defined(PRINT_CHKSUM) - write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var) -#else - do i=ISTART,min(IEND,size(var(:,1,1))) - do k=KSTART,min(KEND,size(var(1,:,1))) - do l=1,size(var(1,1,:)) - write(0,'(2a,3i6,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, l, var(i,k,l) - end do - end do - end do -#endif - - end subroutine print_real_3d - - function chksum_int(N, var) result(hash) - implicit none - integer, intent(in) :: N - integer, dimension(1:N), intent(in) :: var - integer*8, dimension(1:N) :: int_var - integer*8 :: a, b, i, hash - integer*8, parameter :: mod_adler=65521 - - a=1 - b=0 - i=1 - hash = 0 - int_var = TRANSFER(var, a, N) - - do i= 1, N - a = MOD(a + int_var(i), mod_adler) - b = MOD(b+a, mod_adler) - end do - - hash = ior(b * 65536, a) - - end function chksum_int - - function chksum_real(N, var) result(hash) - use machine, only: kind_phys - implicit none - integer, intent(in) :: N - real(kind_phys), dimension(1:N), intent(in) :: var - integer*8, dimension(1:N) :: int_var - integer*8 :: a, b, i, hash - integer*8, parameter :: mod_adler=65521 - - a=1 - b=0 - i=1 - hash = 0 - int_var = TRANSFER(var, a, N) - - do i= 1, N - a = MOD(a + int_var(i), mod_adler) - b = MOD(b+a, mod_adler) - end do - - hash = ior(b * 65536, a) - - end function chksum_real - - function print_my_stuff(mpitoprint,omptoprint) result(flag) -#ifdef MPI - use mpi -#endif -#ifdef OPENMP - use omp_lib -#endif - implicit none - integer, intent(in) :: mpitoprint, omptoprint - logical :: flag - integer :: ompthread, mpirank, ierr -#ifdef MPI - call MPI_COMM_RANK(MPI_COMM_WORLD, mpirank, ierr) -#else - mpirank = 0 -#endif -#ifdef OPENMP - ompthread = OMP_GET_THREAD_NUM() -#else - ompthread = 0 -#endif - - if (mpitoprint==mpirank .and. omptoprint==ompthread) then - flag = .true. - else - flag = .false. - end if - end function print_my_stuff - end module GFS_diagtoscreen module GFS_interstitialtoscreen + use print_var_chksum, only: print_var + + implicit none + private public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize @@ -839,6 +881,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup integer :: impi, iomp, ierr integer :: mpirank, mpisize, mpicomm integer :: omprank, ompsize + integer :: istart, iend, kstart, kend ! Initialize CCPP error handling variables errmsg = '' @@ -871,7 +914,373 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup do impi=0,mpisize-1 do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then - call Interstitial%mprint(Model,mpirank,omprank,blkno) + ! Print static variables + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%h2o_coeff ', Interstitial%h2o_coeff ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'sum(Interstitial%h2o_pres) ', Interstitial%h2o_pres ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ipr ', Interstitial%ipr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%itc ', Interstitial%itc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%latidxprnt ', Interstitial%latidxprnt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levi ', Interstitial%levi ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levh2o ', Interstitial%levh2o ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levozp ', Interstitial%levozp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmk ', Interstitial%lmk ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmp ', Interstitial%lmp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdlw ', Interstitial%nbdlw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdsw ', Interstitial%nbdsw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aelw ', Interstitial%nf_aelw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aesw ', Interstitial%nf_aesw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nsamftrac ', Interstitial%nsamftrac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nscav ', Interstitial%nscav ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nspc1 ', Interstitial%nspc1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ntiwx ', Interstitial%ntiwx ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nvdiff ', Interstitial%nvdiff ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oz_coeff ', Interstitial%oz_coeff ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'sum(Interstitial%oz_pres) ', Interstitial%oz_pres ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%phys_hydrostatic ', Interstitial%phys_hydrostatic ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%skip_macro ', Interstitial%skip_macro ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans_aero ', Interstitial%trans_aero ) + ! Print all other variables + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjsfculw_land ', Interstitial%adjsfculw_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjsfculw_ice ', Interstitial%adjsfculw_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjsfculw_ocean ', Interstitial%adjsfculw_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjnirbmd ', Interstitial%adjnirbmd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjnirbmu ', Interstitial%adjnirbmu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjnirdfd ', Interstitial%adjnirdfd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjnirdfu ', Interstitial%adjnirdfu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjvisbmd ', Interstitial%adjvisbmd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjvisbmu ', Interstitial%adjvisbmu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjvisdfu ', Interstitial%adjvisdfu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjvisdfd ', Interstitial%adjvisdfd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%aerodp ', Interstitial%aerodp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%alb1d ', Interstitial%alb1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%bexp1d ', Interstitial%bexp1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cd ', Interstitial%cd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cd_ice ', Interstitial%cd_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cd_land ', Interstitial%cd_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cd_ocean ', Interstitial%cd_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cdq ', Interstitial%cdq ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cdq_ice ', Interstitial%cdq_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cdq_land ', Interstitial%cdq_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cdq_ocean ', Interstitial%cdq_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%chh_ice ', Interstitial%chh_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%chh_land ', Interstitial%chh_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%chh_ocean ', Interstitial%chh_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cldf ', Interstitial%cldf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cldsa ', Interstitial%cldsa ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cldtaulw ', Interstitial%cldtaulw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cldtausw ', Interstitial%cldtausw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld1d ', Interstitial%cld1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clw ', Interstitial%clw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clx ', Interstitial%clx ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clouds ', Interstitial%clouds ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_ice ', Interstitial%cmm_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_land ', Interstitial%cmm_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_ocean ', Interstitial%cmm_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvc ', Interstitial%cnvc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvw ', Interstitial%cnvw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_r ', Interstitial%ctei_r ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_rml ', Interstitial%ctei_rml ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cumabs ', Interstitial%cumabs ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dd_mf ', Interstitial%dd_mf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%de_lgth ', Interstitial%de_lgth ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%del ', Interstitial%del ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%del_gz ', Interstitial%del_gz ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%delr ', Interstitial%delr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dkt ', Interstitial%dkt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dlength ', Interstitial%dlength ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dqdt ', Interstitial%dqdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dqsfc1 ', Interstitial%dqsfc1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%drain ', Interstitial%drain ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt ', Interstitial%dtdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdtc ', Interstitial%dtdtc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtsfc1 ', Interstitial%dtsfc1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtzm ', Interstitial%dtzm ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dt_mf ', Interstitial%dt_mf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt ', Interstitial%dudt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dusfcg ', Interstitial%dusfcg ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dusfc1 ', Interstitial%dusfc1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdftra ', Interstitial%dvdftra ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt ', Interstitial%dvdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvsfcg ', Interstitial%dvsfcg ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvsfc1 ', Interstitial%dvsfc1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dzlyr ', Interstitial%dzlyr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%elvmax ', Interstitial%elvmax ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ep1d ', Interstitial%ep1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ep1d_ice ', Interstitial%ep1d_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ep1d_land ', Interstitial%ep1d_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ep1d_ocean ', Interstitial%ep1d_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evapq ', Interstitial%evapq ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evap_ice ', Interstitial%evap_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evap_land ', Interstitial%evap_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evap_ocean ', Interstitial%evap_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evbs ', Interstitial%evbs ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%evcw ', Interstitial%evcw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%faerlw ', Interstitial%faerlw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%faersw ', Interstitial%faersw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffhh_ice ', Interstitial%ffhh_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffhh_land ', Interstitial%ffhh_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffhh_ocean ', Interstitial%ffhh_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fh2 ', Interstitial%fh2 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fh2_ice ', Interstitial%fh2_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fh2_land ', Interstitial%fh2_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fh2_ocean ', Interstitial%fh2_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%flag_cice ', Interstitial%flag_cice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%flag_guess ', Interstitial%flag_guess ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%flag_iter ', Interstitial%flag_iter ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffmm_ice ', Interstitial%ffmm_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffmm_land ', Interstitial%ffmm_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ffmm_ocean ', Interstitial%ffmm_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10 ', Interstitial%fm10 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_ice ', Interstitial%fm10_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_land ', Interstitial%fm10_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_ocean ', Interstitial%fm10_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frain ', Interstitial%frain ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frland ', Interstitial%frland ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fscav ', Interstitial%fscav ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fswtr ', Interstitial%fswtr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gabsbdlw ', Interstitial%gabsbdlw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gabsbdlw_ice ', Interstitial%gabsbdlw_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gabsbdlw_land ', Interstitial%gabsbdlw_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gabsbdlw_ocean ', Interstitial%gabsbdlw_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gamma ', Interstitial%gamma ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gamq ', Interstitial%gamq ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gamt ', Interstitial%gamt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gasvmr ', Interstitial%gasvmr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gflx ', Interstitial%gflx ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gflx_ice ', Interstitial%gflx_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gflx_land ', Interstitial%gflx_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gflx_ocean ', Interstitial%gflx_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gwdcu ', Interstitial%gwdcu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gwdcv ', Interstitial%gwdcv ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hefac ', Interstitial%hefac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hffac ', Interstitial%hffac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hflxq ', Interstitial%hflxq ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hflx_ice ', Interstitial%hflx_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hflx_land ', Interstitial%hflx_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%hflx_ocean ', Interstitial%hflx_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htlwc ', Interstitial%htlwc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htlw0 ', Interstitial%htlw0 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htswc ', Interstitial%htswc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htsw0 ', Interstitial%htsw0 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dry(:)==.true. ', Interstitial%dry ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%idxday ', Interstitial%idxday ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icy(:)==.true. ', Interstitial%icy ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lake(:)==.true. ', Interstitial%lake ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ocean(:)==.true. ', Interstitial%ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%islmsk ', Interstitial%islmsk ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%islmsk_cice ', Interstitial%islmsk_cice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wet(:)==.true. ', Interstitial%wet ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kb ', Interstitial%kb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kbot ', Interstitial%kbot ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kcnv ', Interstitial%kcnv ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kd ', Interstitial%kd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kinver ', Interstitial%kinver ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kpbl ', Interstitial%kpbl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kt ', Interstitial%kt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ktop ', Interstitial%ktop ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%mbota ', Interstitial%mbota ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%mtopa ', Interstitial%mtopa ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nday ', Interstitial%nday ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oa4 ', Interstitial%oa4 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oc ', Interstitial%oc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%olyr ', Interstitial%olyr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%plvl ', Interstitial%plvl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%plyr ', Interstitial%plyr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%prcpmp ', Interstitial%prcpmp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%prnum ', Interstitial%prnum ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qlyr ', Interstitial%qlyr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_ice ', Interstitial%qss_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_land ', Interstitial%qss_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_ocean ', Interstitial%qss_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%radar_reset ', Interstitial%radar_reset ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raddt ', Interstitial%raddt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincd ', Interstitial%raincd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincs ', Interstitial%raincs ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rainmcadj ', Interstitial%rainmcadj ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rainp ', Interstitial%rainp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rb ', Interstitial%rb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rb_ice ', Interstitial%rb_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rb_land ', Interstitial%rb_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rb_ocean ', Interstitial%rb_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%reset ', Interstitial%reset ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rhc ', Interstitial%rhc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%runoff ', Interstitial%runoff ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%save_q ', Interstitial%save_q ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%save_t ', Interstitial%save_t ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%save_tcp ', Interstitial%save_tcp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%save_u ', Interstitial%save_u ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%save_v ', Interstitial%save_v ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sbsno ', Interstitial%sbsno ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%uvbfc ', Interstitial%scmpsw%uvbfc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%uvbf0 ', Interstitial%scmpsw%uvbf0 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%nirbm ', Interstitial%scmpsw%nirbm ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%nirdf ', Interstitial%scmpsw%nirdf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%visbm ', Interstitial%scmpsw%visbm ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%visdf ', Interstitial%scmpsw%visdf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_ice ', Interstitial%semis_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_land ', Interstitial%semis_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_ocean ', Interstitial%semis_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sfcalb ', Interstitial%sfcalb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigma ', Interstitial%sigma ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmaf ', Interstitial%sigmaf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmafrac ', Interstitial%sigmafrac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmatot ', Interstitial%sigmatot ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%slopetype ', Interstitial%slopetype ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowc ', Interstitial%snowc ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_ice ', Interstitial%snowd_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_land ', Interstitial%snowd_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_ocean ', Interstitial%snowd_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snohf ', Interstitial%snohf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmt ', Interstitial%snowmt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%soiltype ', Interstitial%soiltype ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress ', Interstitial%stress ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress_ice ', Interstitial%stress_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress_land ', Interstitial%stress_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress_ocean ', Interstitial%stress_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%theta ', Interstitial%theta ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tice ', Interstitial%tice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tlvl ', Interstitial%tlvl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tlyr ', Interstitial%tlyr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tprcp_ice ', Interstitial%tprcp_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tprcp_land ', Interstitial%tprcp_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tprcp_ocean ', Interstitial%tprcp_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans ', Interstitial%trans ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tseal ', Interstitial%tseal ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfa ', Interstitial%tsfa ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_ice ', Interstitial%tsfc_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_land ', Interstitial%tsfc_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_ocean ', Interstitial%tsfc_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfg ', Interstitial%tsfg ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf ', Interstitial%tsurf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ice ', Interstitial%tsurf_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_land ', Interstitial%tsurf_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ocean ', Interstitial%tsurf_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ud_mf ', Interstitial%ud_mf ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%uustar_ice ', Interstitial%uustar_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%uustar_land ', Interstitial%uustar_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%uustar_ocean ', Interstitial%uustar_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%vdftra ', Interstitial%vdftra ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%vegf1d ', Interstitial%vegf1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%vegtype ', Interstitial%vegtype ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wcbmax ', Interstitial%wcbmax ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_ice ', Interstitial%weasd_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_land ', Interstitial%weasd_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_ocean ', Interstitial%weasd_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wind ', Interstitial%wind ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%work1 ', Interstitial%work1 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%work2 ', Interstitial%work2 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%work3 ', Interstitial%work3 ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%xcosz ', Interstitial%xcosz ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%xlai1d ', Interstitial%xlai1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%xmu ', Interstitial%xmu ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%z01d ', Interstitial%z01d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_ice ', Interstitial%zorl_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_land ', Interstitial%zorl_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_ocean ', Interstitial%zorl_ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zt1d ', Interstitial%zt1d ) + ! CIRES UGWP v0 + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) + !-- GSD drag suite + if (Model%gwd_opt==3 .or. Model%gwd_opt==33) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%varss ', Interstitial%varss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ocss ', Interstitial%ocss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oa4ss ', Interstitial%oa4ss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clxss ', Interstitial%clxss ) + end if + ! GFDL and Thompson MP + if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%graupelmp ', Interstitial%graupelmp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icemp ', Interstitial%icemp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rainmp ', Interstitial%rainmp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmp ', Interstitial%snowmp ) + ! Ferrier-Aligo + else if (Model%imp_physics == Model%imp_physics_fer_hires) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_ice ', Interstitial%f_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_rain ', Interstitial%f_rain ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_rimef ', Interstitial%f_rimef ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cwm ', Interstitial%cwm ) + ! Morrison-Gettelman + else if (Model%imp_physics == Model%imp_physics_mg) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncgl ', Interstitial%ncgl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncpr ', Interstitial%ncpr ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncps ', Interstitial%ncps ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qgl ', Interstitial%qgl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qrn ', Interstitial%qrn ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qsnw ', Interstitial%qsnw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qlcn ', Interstitial%qlcn ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qicn ', Interstitial%qicn ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%w_upi ', Interstitial%w_upi ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cf_upi ', Interstitial%cf_upi ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnv_mfd ', Interstitial%cnv_mfd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnv_dqldt ', Interstitial%cnv_dqldt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clcn ', Interstitial%clcn ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnv_fice ', Interstitial%cnv_fice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnv_ndrop ', Interstitial%cnv_ndrop ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnv_nice ', Interstitial%cnv_nice ) + end if + ! SHOC + if (Model%do_shoc) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncgl ', Interstitial%ncgl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qrn ', Interstitial%qrn ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qsnw ', Interstitial%qsnw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qgl ', Interstitial%qgl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncpi ', Interstitial%ncpi ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncpl ', Interstitial%ncpl ) + end if + ! Noah MP + if (Model%lsm == Model%lsm_noahmp) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%t2mmp ', Interstitial%t2mmp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%q2mp ', Interstitial%q2mp ) + end if + ! RRTMGP + if (Model%do_RRTMGP) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%aerosolslw ', Interstitial%aerosolslw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%aerosolssw ', Interstitial%aerosolssw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_frac ', Interstitial%cld_frac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_lwp ', Interstitial%cld_lwp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_reliq ', Interstitial%cld_reliq ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_iwp ', Interstitial%cld_iwp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_reice ', Interstitial%cld_reice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_swp ', Interstitial%cld_swp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_resnow ', Interstitial%cld_resnow ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_rwp ', Interstitial%cld_rwp ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_rerain ', Interstitial%cld_rerain ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%precip_frac ', Interstitial%precip_frac ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_lw ', Interstitial%icseed_lw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_sw ', Interstitial%icseed_sw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_allsky ', Interstitial%fluxlwUP_allsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_allsky ', Interstitial%fluxlwDOWN_allsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_clrsky ', Interstitial%fluxlwUP_clrsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_clrsky ', Interstitial%fluxlwDOWN_clrsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswUP_allsky ', Interstitial%fluxswUP_allsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswDOWN_allsky ', Interstitial%fluxswDOWN_allsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswUP_clrsky ', Interstitial%fluxswUP_clrsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswDOWN_clrsky ', Interstitial%fluxswDOWN_clrsky ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%relhum ', Interstitial%relhum ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%q_lay ', Interstitial%q_lay ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qs_lay ', Interstitial%qs_lay ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%deltaZ ', Interstitial%deltaZ ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%p_lay ', Interstitial%p_lay ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%p_lev ', Interstitial%p_lev ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%t_lay ', Interstitial%t_lay ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%t_lev ', Interstitial%t_lev ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tv_lay ', Interstitial%tv_lay ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cloud_overlap_param ', Interstitial%cloud_overlap_param ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%precip_overlap_param', Interstitial%precip_overlap_param ) + end if end if #ifdef OPENMP !$OMP BARRIER @@ -927,8 +1336,8 @@ subroutine GFS_abort_run (Model, blkno, errmsg, errflg) errmsg = '' errflg = 0 - if (Model%kdt==1 .and. blkno==4) then - if (Model%me==0) write(0,*) "GFS_abort_run: ABORTING MODEL" + if (Model%kdt==1 .and. blkno==size(Model%blksz)) then + if (Model%me==Model%master) write(0,*) "GFS_abort_run: ABORTING MODEL" call sleep(10) stop end if @@ -939,104 +1348,104 @@ end module GFS_abort module GFS_checkland - private + private - public GFS_checkland_init, GFS_checkland_run, GFS_checkland_finalize + public GFS_checkland_init, GFS_checkland_run, GFS_checkland_finalize - contains + contains - subroutine GFS_checkland_init () - end subroutine GFS_checkland_init + subroutine GFS_checkland_init () + end subroutine GFS_checkland_init - subroutine GFS_checkland_finalize () - end subroutine GFS_checkland_finalize + subroutine GFS_checkland_finalize () + end subroutine GFS_checkland_finalize !> \section arg_table_GFS_checkland_run Argument Table !! \htmlinclude GFS_checkland_run.html !! - subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope, & - soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean, & - oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg ) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in ) :: me - integer, intent(in ) :: master - integer, intent(in ) :: blkno - integer, intent(in ) :: im - integer, intent(in ) :: kdt - integer, intent(in ) :: iter - logical, intent(in ) :: flag_iter(im) - logical, intent(in ) :: flag_guess(im) - logical, intent(in ) :: flag_init - logical, intent(in ) :: flag_restart - logical, intent(in ) :: frac_grid - integer, intent(in ) :: isot - integer, intent(in ) :: ivegsrc - real(kind_phys), intent(in ) :: stype(im) - real(kind_phys), intent(in ) :: vtype(im) - real(kind_phys), intent(in ) :: slope(im) - integer, intent(in ) :: soiltyp(im) - integer, intent(in ) :: vegtype(im) - integer, intent(in ) :: slopetyp(im) - logical, intent(in ) :: dry(im) - logical, intent(in ) :: icy(im) - logical, intent(in ) :: wet(im) - logical, intent(in ) :: lake(im) - logical, intent(in ) :: ocean(im) - real(kind_phys), intent(in ) :: oceanfrac(im) - real(kind_phys), intent(in ) :: landfrac(im) - real(kind_phys), intent(in ) :: lakefrac(im) - real(kind_phys), intent(in ) :: slmsk(im) - integer, intent(in ) :: islmsk(im) - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Local variables - integer :: i - - errflg = 0 - errmsg = '' - - write(0,'(a,i5)') 'YYY: me :', me - write(0,'(a,i5)') 'YYY: master :', master - write(0,'(a,i5)') 'YYY: blkno :', blkno - write(0,'(a,i5)') 'YYY: im :', im - write(0,'(a,i5)') 'YYY: kdt :', kdt - write(0,'(a,i5)') 'YYY: iter :', iter - write(0,'(a,1x,l)') 'YYY: flag_init :', flag_init - write(0,'(a,1x,l)') 'YYY: flag_restart :', flag_restart - write(0,'(a,1x,l)') 'YYY: frac_grid :', frac_grid - write(0,'(a,i5)') 'YYY: isot :', isot - write(0,'(a,i5)') 'YYY: ivegsrc :', ivegsrc - - do i=1,im - !if (vegtype(i)==15) then - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, soiltyp(i) :', i, blkno, soiltyp(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vegtype(i) :', i, blkno, vegtype(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slopetyp(i) :', i, blkno, slopetyp(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i) :', i, blkno, lake(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i) :', i, blkno, ocean(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i) :', i, blkno, oceanfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, landfrac(i) :', i, blkno, landfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, lakefrac(i) :', i, blkno, lakefrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slmsk(i) :', i, blkno, slmsk(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, islmsk(i) :', i, blkno, islmsk(i) - !end if - end do - - end subroutine GFS_checkland_run + subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & + flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope, & + soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean, & + oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg ) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in ) :: me + integer, intent(in ) :: master + integer, intent(in ) :: blkno + integer, intent(in ) :: im + integer, intent(in ) :: kdt + integer, intent(in ) :: iter + logical, intent(in ) :: flag_iter(im) + logical, intent(in ) :: flag_guess(im) + logical, intent(in ) :: flag_init + logical, intent(in ) :: flag_restart + logical, intent(in ) :: frac_grid + integer, intent(in ) :: isot + integer, intent(in ) :: ivegsrc + real(kind_phys), intent(in ) :: stype(im) + real(kind_phys), intent(in ) :: vtype(im) + real(kind_phys), intent(in ) :: slope(im) + integer, intent(in ) :: soiltyp(im) + integer, intent(in ) :: vegtype(im) + integer, intent(in ) :: slopetyp(im) + logical, intent(in ) :: dry(im) + logical, intent(in ) :: icy(im) + logical, intent(in ) :: wet(im) + logical, intent(in ) :: lake(im) + logical, intent(in ) :: ocean(im) + real(kind_phys), intent(in ) :: oceanfrac(im) + real(kind_phys), intent(in ) :: landfrac(im) + real(kind_phys), intent(in ) :: lakefrac(im) + real(kind_phys), intent(in ) :: slmsk(im) + integer, intent(in ) :: islmsk(im) + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Local variables + integer :: i + + errflg = 0 + errmsg = '' + + write(0,'(a,i5)') 'YYY: me :', me + write(0,'(a,i5)') 'YYY: master :', master + write(0,'(a,i5)') 'YYY: blkno :', blkno + write(0,'(a,i5)') 'YYY: im :', im + write(0,'(a,i5)') 'YYY: kdt :', kdt + write(0,'(a,i5)') 'YYY: iter :', iter + write(0,'(a,1x,l)') 'YYY: flag_init :', flag_init + write(0,'(a,1x,l)') 'YYY: flag_restart :', flag_restart + write(0,'(a,1x,l)') 'YYY: frac_grid :', frac_grid + write(0,'(a,i5)') 'YYY: isot :', isot + write(0,'(a,i5)') 'YYY: ivegsrc :', ivegsrc + + do i=1,im + !if (vegtype(i)==15) then + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, soiltyp(i) :', i, blkno, soiltyp(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vegtype(i) :', i, blkno, vegtype(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slopetyp(i) :', i, blkno, slopetyp(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i) :', i, blkno, lake(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i) :', i, blkno, ocean(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i) :', i, blkno, oceanfrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, landfrac(i) :', i, blkno, landfrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, lakefrac(i) :', i, blkno, lakefrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slmsk(i) :', i, blkno, slmsk(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, islmsk(i) :', i, blkno, islmsk(i) + !end if + end do + + end subroutine GFS_checkland_run end module GFS_checkland From 2245a5dd66b88f5b35352963b8fbea848d50377f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 1 Sep 2020 09:57:16 -0600 Subject: [PATCH 78/97] Correct typos in comment in GFS_debug.F90 --- physics/GFS_debug.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index e889d94df..35b44ca0e 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -916,7 +916,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup if (mpirank==impi .and. omprank==iomp) then ! Print static variables call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%h2o_coeff ', Interstitial%h2o_coeff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'sum(Interstitial%h2o_pres) ', Interstitial%h2o_pres ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%h2o_pres ', Interstitial%h2o_pres ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ipr ', Interstitial%ipr ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%itc ', Interstitial%itc ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%latidxprnt ', Interstitial%latidxprnt ) @@ -1062,14 +1062,14 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htlw0 ', Interstitial%htlw0 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htswc ', Interstitial%htswc ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%htsw0 ', Interstitial%htsw0 ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dry(:)==.true. ', Interstitial%dry ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dry ', Interstitial%dry ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%idxday ', Interstitial%idxday ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icy(:)==.true. ', Interstitial%icy ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lake(:)==.true. ', Interstitial%lake ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ocean(:)==.true. ', Interstitial%ocean ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icy ', Interstitial%icy ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lake ', Interstitial%lake ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ocean ', Interstitial%ocean ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%islmsk ', Interstitial%islmsk ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%islmsk_cice ', Interstitial%islmsk_cice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wet(:)==.true. ', Interstitial%wet ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wet ', Interstitial%wet ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kb ', Interstitial%kb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kbot ', Interstitial%kbot ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kcnv ', Interstitial%kcnv ) From 58aecc785a02322035abf1fe1697243e44f51b16 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Sep 2020 09:59:07 -0600 Subject: [PATCH 79/97] Revert change to .gitmodules and update submodule pointer for rte-rrtmgp --- .gitmodules | 6 ++---- physics/rte-rrtmgp | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index a49d2434f..5bcc65869 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,4 @@ [submodule "physics/rte-rrtmgp"] path = physics/rte-rrtmgp - #url = https://github.com/earth-system-radiation/rte-rrtmgp - #branch = dtc/ccpp - url = https://github.com/climbfuji/rte-rrtmgp - branch = add_ccpp_table_properties_and_dependencies + url = https://github.com/earth-system-radiation/rte-rrtmgp + branch = dtc/ccpp diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 88a43f797..566bee9cd 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 88a43f797ab3eb3c5c978485bd108a8386a6cdfd +Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d From 361cc15b6328f6754127aad337de2e7f93c9f8a7 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 2 Sep 2020 16:59:25 +0000 Subject: [PATCH 80/97] Syntax errors corrected. Still has an issue in compilation with the use 0f function message. --- physics/sfcsub.F | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 41110c7c5..a9328f9bf 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -1844,14 +1844,16 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & rla,rlo,len,kqcm,percrit,lgchek,me) !-- soil moisture forecast do k=1,lsoil - call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs,snofcs,icefl1, + call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs, + & snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo !-- soil temperature forecast do k=1,lsoil - call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs,snofcs,icefl1, + call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs, + & snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -8605,6 +8607,8 @@ subroutine snodpth2(glacir,snwmax,snoanl, len, me) enddo return end + +!>\ingroup mod_sfcsub function message(prefix,index) implicit none character(len=*), intent(in) :: prefix @@ -8615,4 +8619,5 @@ function message(prefix,index) ! string representation of index <= len(message) write(message,fmt='(a,a,i0)') trim(prefix), '-', index end function message + !>@} From cc1d5bdaea82a880e695f19205a2203ac2eb751d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Sep 2020 13:35:58 -0600 Subject: [PATCH 81/97] Revert change to rte-rrtmgp submodule pointer --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..6ee0b62c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7 From 922c05f452ee3f8c58410672002d371fd1eb0838 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Sep 2020 13:36:20 -0600 Subject: [PATCH 82/97] physics/sfcsub.F: move message into sfccyc_module --- physics/sfcsub.F | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index a9328f9bf..30f663ec5 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -36,6 +36,20 @@ module sfccyc_module integer :: veg_type_landice integer :: soil_type_landice ! +! + contains + + function message(prefix,index) + implicit none + character(len=*), intent(in) :: prefix + integer, intent(in) :: index + character(len=10) :: message + ! + ! probably need to implement a check that len(prefix) + '-' + length of + ! string representation of index <= len(message) + write(message,fmt='(a,a,i0)') trim(prefix), '-', index + end function message + end module sfccyc_module !>\ingroup mod_GFS_phys_time_vary @@ -8608,16 +8622,4 @@ subroutine snodpth2(glacir,snwmax,snoanl, len, me) return end -!>\ingroup mod_sfcsub - function message(prefix,index) - implicit none - character(len=*), intent(in) :: prefix - integer, intent(in) :: index - character(len=10) :: message - ! - ! probably need to implement a check that len(prefix) + '-' + length of - ! string representation of index <= len(message) - write(message,fmt='(a,a,i0)') trim(prefix), '-', index - end function message - !>@} From e19d00da14a774ad970f519a055b2a4718c442ac Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Sep 2020 17:29:34 -0600 Subject: [PATCH 83/97] Increase length of message and update declaration in qcmxmn to avoid writing out of bounds --- physics/sfcsub.F | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 30f663ec5..57aff87d4 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -43,10 +43,8 @@ function message(prefix,index) implicit none character(len=*), intent(in) :: prefix integer, intent(in) :: index - character(len=10) :: message - ! - ! probably need to implement a check that len(prefix) + '-' + length of - ! string representation of index <= len(message) + ! Safety measure: prevent writing out of bounds, use a longer string + character(len=128) :: message write(message,fmt='(a,a,i0)') trim(prefix), '-', index end function message @@ -5234,7 +5232,7 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & & ij,nprt,kmaxs,kmins,i,me,len,mode parameter(mmprt=2) ! - character*8 ttl + character(len=*) ttl logical iceflg(len) real (kind=kind_io8) fld(len),slimsk(len),sno(len), & & rla(len), rlo(len) From 317c5cd465bedbba939295d59e0503eea8d057c1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 3 Sep 2020 15:10:19 -0600 Subject: [PATCH 84/97] physics/sfcsub.F: reduce length of message string for prettier output --- physics/sfcsub.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 57aff87d4..b0fe168bd 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -43,8 +43,8 @@ function message(prefix,index) implicit none character(len=*), intent(in) :: prefix integer, intent(in) :: index - ! Safety measure: prevent writing out of bounds, use a longer string - character(len=128) :: message + ! Safety measure: prevent writing out of bounds, use a longer string than 8 characters + character(len=16) :: message write(message,fmt='(a,a,i0)') trim(prefix), '-', index end function message From 8f8dd2e8e00145027568e3e34b8bd5dc2fe680ec Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 4 Sep 2020 08:53:05 -0600 Subject: [PATCH 85/97] physics/tracer_sanitizer.meta: add [ccpp-table-properties] section --- physics/tracer_sanitizer.meta | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/physics/tracer_sanitizer.meta b/physics/tracer_sanitizer.meta index 582823fdb..0378911ed 100644 --- a/physics/tracer_sanitizer.meta +++ b/physics/tracer_sanitizer.meta @@ -1,3 +1,10 @@ +[ccpp-table-properties] + name = tracer_sanitizer + type = scheme + dependencies = machine.F + +######################################################################## + [ccpp-arg-table] name = tracer_sanitizer_run type = scheme From a05e096db0c1176140ef49032a71178c4cbe7089 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 4 Sep 2020 21:43:01 +0000 Subject: [PATCH 86/97] Some progress made but still the model crashes. The changes include: 1. Use the same logic as in GFS_surface_composites_pre_run to define variables: land, icy and wet. 2. Use real stype and vtype that are defined in the INIT step. The land points are initialized now correctly, but the crash happens in the GF scheme presumably over water or ice point. --- physics/module_sf_ruclsm.F90 | 21 ++-- physics/sfc_drv_ruc.F90 | 233 +++++++++++++++++++++++------------ physics/sfc_drv_ruc.meta | 75 +++++++---- 3 files changed, 212 insertions(+), 117 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index e02e1edb0..1a7037cf7 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -7075,6 +7075,7 @@ SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & errflag = 0 DO j = jts,jtf DO i = its,itf + IF ( ISLTYP( i,j ) .LT. 0 ) THEN errflag = 1 print *, & @@ -7128,23 +7129,23 @@ SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & endif ENDDO - elseif(icy(i) .and. .not. frac_grid ) then + elseif( icy(i) .and. .not. frac_grid ) then !-- ice DO L=1,NZS smfr3d(i,l,j)=1. sh2o(i,l,j)=0. mavail(i,j) = 1. ENDDO - endif ! land - !else -!-- for water ISLTYP=14 - ! DO L=1,NZS - ! smfr3d(i,l,j)=0. - ! sh2o(i,l,j)=1. - ! mavail(i,j) = 1. - ! ENDDO - !endif + elseif( .not. frac_grid) then + !-- water ISLTYP=14 + DO L=1,NZS + smfr3d(i,l,j)=0. + sh2o(i,l,j)=1. + mavail(i,j) = 1. + ENDDO + + endif ! land !ENDIF ENDDO diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index db1ad00b4..3b84f6bf9 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -16,6 +16,8 @@ module lsm_ruc public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_finalize + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + contains !> This subroutine calls set_soilveg_ruc() to specify vegetation and soil parameters for @@ -26,9 +28,10 @@ module lsm_ruc subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, & im, lsoil_ruc, lsoil, kice, nlev, & ! in - lsm_ruc, lsm, & ! in - soiltyp, vegtype, frac_grid, land, icy, & ! in - fice, tsfc_lnd, tsfc_wat, tice, & + lsm_ruc, lsm, slmsk, landfrac, & ! in + stype, vtype, frac_grid, & ! in + flag_cice, min_seaice, min_lakeice, & + fice, tsfc_lnd, tsfc_wat, & tg3, smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, wetness, & ! out @@ -46,19 +49,22 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & integer, intent(in) :: kice integer, intent(in) :: nlev integer, intent(in) :: lsm_ruc, lsm - integer,dimension(im),intent(inout) :: soiltyp, vegtype - logical, dimension(im), intent(in) :: land, icy - real (kind=kind_phys), dimension(im), intent(in ) :: fice + real (kind=kind_phys), dimension(im), intent(in ) :: slmsk + real (kind=kind_phys), dimension(im), intent(in ) :: landfrac + real (kind=kind_phys), dimension(im), intent(in ) :: stype + real (kind=kind_phys), dimension(im), intent(in ) :: vtype + logical, dimension(im), intent(in ) :: flag_cice + real (kind=kind_phys), intent(in ) :: min_lakeice, min_seaice real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_lnd real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_wat - real (kind=kind_phys), dimension(im), intent(in ) :: tice real (kind=kind_phys), dimension(im), intent(in) :: tg3 real (kind=kind_phys), dimension(im,lsoil), intent(in) :: smc,slc,stc ! --- in/out: + real (kind=kind_phys), dimension(im), intent(inout) :: fice real (kind=kind_phys), dimension(im), intent(inout) :: wetness real (kind=kind_phys), dimension(im), intent(inout) :: smcref2, smcwlt2 @@ -73,31 +79,32 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- local integer :: ipr, i, k logical :: debug_print + logical, dimension(im) :: land, icy, wet + integer, dimension(im) :: soiltyp, vegtype + real (kind=kind_phys), dimension(im) :: frland ! Initialize CCPP error handling variables errmsg = '' errflg = 0 ipr = 10 - debug_print = .true. + debug_print = .false. !> - Call rucinit() to initialize soil/ice/water variables if ( debug_print) then write (0,*) 'RUC LSM initialization' write (0,*) 'lsoil_ruc, lsoil',lsoil_ruc, lsoil - write (0,*) 'noah soil temp',stc(:,1) - write (0,*) 'noah soil mois',smc(:,1) + write (0,*) 'me, isot, ivegsrc, nlunit ',me, isot, ivegsrc, nlunit + write (0,*) 'noah soil temp',stc(ipr,:) write (0,*) 'noah mois(ipr)',ipr,smc(ipr,:) - write (0,*) 'soiltyp=',soiltyp(:) - write (0,*) 'vegtype=',vegtype(:) - write (0,*) 'fice=',fice(:) - write (0,*) 'tice=',tice(:) - write (0,*) 'tsfc_lnd=',tsfc_lnd(:) - write (0,*) 'tsfc_wat=',tsfc_wat(:) - write (0,*) 'tg3=',tg3(:) - write (0,*) 'land=',land(:) - write (0,*) 'icy=',icy(:) + write (0,*) 'stype=',stype(ipr) + write (0,*) 'vtype=',vtype(ipr) + write (0,*) 'fice=',fice(ipr) + write (0,*) 'tsfc_lnd=',tsfc_lnd(ipr) + write (0,*) 'tsfc_wat=',tsfc_wat(ipr) + write (0,*) 'tg3=',tg3(ipr) + write (0,*) 'slmsk=',slmsk(ipr) write (0,*) 'flag_init =',flag_init write (0,*) 'flag_restart =',flag_restart endif @@ -105,13 +112,89 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit) + soiltyp(:) = 0 + vegtype(:) = 0 + land (:) = .false. + icy (:) = .false. + wet (:) = .false. + + if (frac_grid) then ! fice is ice fraction wrt water area + do i=1,im + frland(i) = landfrac(i) + if (frland(i) > zero) land(i) = .true. + if (frland(i) < one) then + if (flag_cice(i)) then + if (fice(i) >= min_seaice) then + icy(i) = .true. + else + fice(i) = zero + endif + else + if (fice(i) >= min_lakeice) then + icy(i) = .true. + else + fice(i) = zero + endif + endif + if (fice(i) < one ) then + wet(i)=.true. ! some open ocean/lake water exists + end if + else + fice(i) = zero + endif + enddo + + else + + do i = 1, IM + frland(i) = zero + if (slmsk(i) == 0) then + wet(i) = .true. + fice(i) = zero + elseif (slmsk(i) == 1) then + land(i) = .true. + frland(i) = one + fice(i) = zero + else + icy(i) = .true. + if (fice(i) < one) then + wet(i) = .true. + endif + endif + enddo + + endif + + do i = 1, im ! i - horizontal loop + if( land(i) ) then + !-- land + soiltyp(i) = int( stype(i)+0.5 ) + vegtype(i) = int( vtype(i)+0.5 ) + elseif( icy(i) > 0. ) then + !-- ice + if (isot == 1) then + soiltyp(i) = 16 + else + soiltyp(i) = 9 + endif + if (ivegsrc == 1) then + vegtype(i) = 15 + elseif(ivegsrc == 2) then + vegtype(i) = 13 + endif + elseif ( wet(i) ) then + !-- water + if (soiltyp(i) < 1) soiltyp(i) = 14 + if (vegtype(i) < 1) vegtype(i) = 17 + endif + enddo + if( .not. flag_restart) then call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in - me, master, isot, ivegsrc, nlunit, & ! in - lsm_ruc, lsm, & ! in + me, master, lsm_ruc, lsm, slmsk, & ! in frac_grid, land, icy, & ! in soiltyp, vegtype, fice, & ! in - tsfc_lnd, tsfc_wat, tice, tg3, & ! in + tsfc_lnd, tsfc_wat, tg3, & ! in smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, & ! out @@ -400,6 +483,8 @@ subroutine lsm_ruc_run & ! inputs endif if(flag_init .and. iter==1) then + ! Initialize the RUC soil levels, needed for cold starts and warm starts + CALL init_soil_depth_3 ( zs , dzs , lsoil_ruc ) xlai = 0. endif ! flag_init=.true.,iter=1 @@ -773,7 +858,7 @@ subroutine lsm_ruc_run & ! inputs znt(i,j) = zorl(i)/100. !if(debug_print) then - if(me==0 .and. i==ipr) then + !if(i==ipr) then write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j write (0,*)'stsoil = ',stsoil(i,:,j), i,j write (0,*)'soilt = ',soilt(i,j), i,j @@ -849,25 +934,12 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'stsoil(i,:,j)=',i,j,stsoil(i,:,j) write (0,*)'smfrsoil(i,:,j)=',i,j,smfrsoil(i,:,j) write (0,*)'keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) - write (0,*)'soilm(i,j) =',i,j,soilm(i,j) - write (0,*)'smmax(i,j) =',i,j,smmax(i,j) - write (0,*)'hfx(i,j) =',i,j,hfx(i,j) - write (0,*)'qfx(i,j) =',i,j,qfx(i,j) - write (0,*)'lh(i,j) =',i,j,lh(i,j) - write (0,*)'infiltr(i,j) =',i,j,infiltr(i,j) - write (0,*)'runoff1(i,j) =',i,j,runoff1(i,j) - write (0,*)'runoff2(i,j) =',i,j,runoff2(i,j) write (0,*)'acrunoff(i,j) =',i,j,acrunoff(i,j) - write (0,*)'sfcexc(i,j) =',i,j,sfcexc(i,j) - write (0,*)'acceta(i,j) =',i,j,acceta(i,j) - write (0,*)'ssoil(i,j) =',i,j,ssoil(i,j) - write (0,*)'snfallac(i,j) =',i,j,snfallac(i,j) write (0,*)'acsn(i,j) =',i,j,acsn(i,j) - write (0,*)'snomlt(i,j) =',i,j,snomlt(i,j) write (0,*)'shdmin1d(i,j) =',i,j,shdmin1d(i,j) write (0,*)'shdmax1d(i,j) =',i,j,shdmax1d(i,j) write (0,*)'rdlai2d =',rdlai2d - endif + !endif !endif !> - Call RUC LSM lsmruc(). @@ -906,7 +978,7 @@ subroutine lsm_ruc_run & ! inputs & its,ite, jts,jte, kts,kte ) !if(debug_print) then - if(me==0.and.i==ipr) then + !if(i==ipr) then write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) @@ -941,7 +1013,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'after snfallac(i,j) =',i,j,snfallac(i,j) write (0,*)'after acsn(i,j) =',i,j,acsn(i,j) write (0,*)'after snomlt(i,j) =',i,j,snomlt(i,j) - endif + !endif !endif @@ -1109,11 +1181,10 @@ end subroutine lsm_ruc_run !>\ingroup lsm_ruc_group !! This subroutine contains RUC LSM initialization. subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in - me, master, isot, ivegsrc, nlunit, & ! in - lsm_ruc, lsm, & ! in + me, master, lsm_ruc, lsm, slmsk, & ! in frac_grid, land, icy, & ! in soiltyp, vegtype, fice, & ! in - tskin_lnd, tskin_wat, tice, tg3, & ! !in + tskin_lnd, tskin_wat, tg3, & ! !in smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, & ! out @@ -1124,14 +1195,13 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in logical, intent(in ) :: restart integer, intent(in ) :: lsm integer, intent(in ) :: lsm_ruc - integer, intent(in ) :: isot - integer, intent(in ) :: ivegsrc, nlunit integer, intent(in ) :: im, nlev integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil logical, intent(in ) :: frac_grid logical, dimension(im), intent(in ) :: land, icy - real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat, tice + real (kind=kind_phys), dimension(im), intent(in ) :: slmsk + real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat real (kind=kind_phys), dimension(im), intent(inout) :: smcref2 real (kind=kind_phys), dimension(im), intent(inout) :: smcwlt2 real (kind=kind_phys), dimension(im), intent(in ) :: tg3 @@ -1165,7 +1235,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer , dimension( 1:im , 1:1 ) :: ivgtyp integer , dimension( 1:im , 1:1) :: isltyp real (kind=kind_phys), dimension( 1:im , 1:1 ) :: mavail - real (kind=kind_phys), dimension( 1:im , 1:1 ) :: xice real (kind=kind_phys), dimension( 1:im , 1:1 ) :: sst real (kind=kind_phys), dimension( 1:im , 1:1 ) :: landmask real (kind=kind_phys), dimension( 1:im , 1:1 ) :: tsk @@ -1274,15 +1343,15 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in endif - !if(debug_print) then + if(debug_print) then write (0,*)'smc(ipr,:) ==', ipr, smc(ipr,:) write (0,*)'stc(ipr,:) ==', ipr, stc(ipr,:) - !write (0,*)'vegtype(ipr) ==', ipr, vegtype(ipr) - !write (0,*)'soiltyp(ipr) ==', ipr, soiltyp(ipr) write (0,*)'tskin_lnd(:)=',tskin_lnd(:) write (0,*)'tskin_wat(:)=',tskin_wat(:) + write (0,*)'vegtype(ipr) ==', ipr, vegtype(ipr) + write (0,*)'soiltyp(ipr) ==', ipr, soiltyp(ipr) write (0,*)'its,ite,jts,jte ',its,ite,jts,jte - !endif + endif do j=jts,jte ! @@ -1290,16 +1359,15 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in sst(i,j) = tskin_wat(i) tbot(i,j)= tg3(i) - ! land only version - if (land(i)) then - tsk(i,j) = tskin_lnd(i) ivgtyp(i,j)=vegtype(i) isltyp(i,j)=soiltyp(i) - !ivgtyp(i,j )= 12 - !isltyp(i,j) = 3 + if (land(i) .or. icy(i)) then + !-- land or ice + tsk(i,j) = tskin_lnd(i) landmask(i,j)=1. - xice(i,j)=0. else + !-- water + tsk(i,j) = tskin_wat(i) landmask(i,j)=0. endif ! land(i) @@ -1311,15 +1379,13 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte ! do i=its,ite ! i = horizontal loop - if (land(i)) then - st_input(i,1,j)=tsk(i,j) sm_input(i,1,j)=0. do k=1,lsoil st_input(i,k+1,j)=stc(i,k) ! convert volumetric soil moisture to SWI (soil wetness index) - if(swi_init) then + if(land(i) .and. swi_init) then !--- initialize smcwlt2 and smcref2 with Noah values smcref2 (i) = REFSMCnoah(soiltyp(i)) smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) @@ -1334,8 +1400,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in sm_input(i,k,j)=0. enddo - endif ! land(i) - enddo ! i - horizontal loop enddo ! jme @@ -1360,17 +1424,21 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite if (land(i)) then - do k=1,lsoil_ruc + do k=1,lsoil_ruc ! convert from SWI to RUC volumetric soil moisture - if(swi_init) then + if(swi_init) then soilm(i,k,j)= dumsm(i,k,j) * & (refsmc(isltyp(i,j))-drysmc(isltyp(i,j))) & + drysmc(isltyp(i,j)) - else - soilm(i,k,j)= dumsm(i,k,j) - endif + else + soilm(i,k,j)= dumsm(i,k,j) + endif soiltemp(i,k,j) = dumt(i,k,j) - enddo + enddo ! k + elseif (icy(i)) then + do k=1,lsoil_ruc + soiltemp(i,k,j) = dumt(i,k,j) + enddo ! k endif ! land(i) enddo enddo @@ -1469,33 +1537,38 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! Initialize liquid and frozen soil moisture from total soil moisture ! and soil temperature, and also soil moisture availability in the top ! layer - !call ruclsminit( debug_print, frac_grid, land, icy, & - ! lsoil_ruc, isltyp, ivgtyp, mavail, & - ! soilh2o, smfr, soiltemp, soilm, & - ! ims,ime, jms,jme, kms,kme, & - ! its,ite, jts,jte, kts,kte ) + + call ruclsminit( debug_print, frac_grid, land, icy, & + lsoil_ruc, isltyp, ivgtyp, mavail, & + soilh2o, smfr, soiltemp, soilm, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) do j=jts,jte do i=its,ite if (land(i)) then - wetness(i) = soilm(i,1,j)/0.5 - !wetness(i) = mavail(i,j) + wetness(i) = mavail(i,j) do k = 1, lsoil_ruc smois(i,k) = soilm(i,k,j) tslb(i,k) = soiltemp(i,k,j) - sh2o(i,k) = soilm(i,k,j) - smfrkeep(i,k) = soilm(i,k,j) - !sh2o(i,k) = soilh2o(i,k,j) - !smfrkeep(i,k) = smfr(i,k,j) + sh2o(i,k) = soilh2o(i,k,j) + smfrkeep(i,k) = smfr(i,k,j) enddo + elseif (icy(i)) then + wetness (i) = 1. + do k = 1, lsoil_ruc + smois(i,k) = 1. + tslb(i,k) = soiltemp(i,k,j) + sh2o(i,k) = 0. + smfrkeep(i,k) = 1. + enddo endif ! land(i) enddo enddo - ! For non-land points, set RUC LSM fields to input (Noah or RUC) fields if (.not. frac_grid) then do i=1,im - if (.not.land(i)) then + if (.not.land(i) .and. .not.icy(i)) then wetness (i) = 1. do k=1,min(lsoil,lsoil_ruc) smois(i,k) = smc(i,k) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 730bcd8c0..3441111e5 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -113,20 +113,40 @@ type = integer intent = in optional = F -[soiltyp] - standard_name = soil_type_classification - long_name = soil type at each grid cell +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm units = index dimensions = (horizontal_dimension) - type = integer - intent = inout + type = real + kind = kind_phys + intent = in optional = F -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm units = index dimensions = (horizontal_dimension) - type = integer + type = real + kind = kind_phys intent = inout optional = F [frac_grid] @@ -137,20 +157,30 @@ type = logical intent = in optional = F -[land] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice units = flag dimensions = (horizontal_dimension) type = logical intent = in optional = F -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = ??? + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = ??? + dimensions = () + type = real + kind = kind_phys intent = in optional = F [fice] @@ -180,15 +210,6 @@ kind = kind_phys intent = inout optional = F -[tice] - standard_name = sea_ice_temperature_interstitial - long_name = sea ice surface skin temperature use as interstitial - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature From f868281cb4f8359869eaa11f530a0e081127c125 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 8 Sep 2020 19:05:17 +0000 Subject: [PATCH 87/97] Removed prints and some clean-up. --- physics/sfc_drv_ruc.F90 | 50 +++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b84f6bf9..6debf4522 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -209,7 +209,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & enddo ! i endif ! flag_restart -!-- end of initialization + !-- end of initialization if ( debug_print) then write (0,*) 'ruc soil tslb',tslb(:,1) @@ -857,8 +857,8 @@ subroutine lsm_ruc_run & ! inputs z0(i,j) = zorl(i)/100. znt(i,j) = zorl(i)/100. - !if(debug_print) then - !if(i==ipr) then + if(debug_print) then + if(i==ipr) then write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j write (0,*)'stsoil = ',stsoil(i,:,j), i,j write (0,*)'soilt = ',soilt(i,j), i,j @@ -939,8 +939,8 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'shdmin1d(i,j) =',i,j,shdmin1d(i,j) write (0,*)'shdmax1d(i,j) =',i,j,shdmax1d(i,j) write (0,*)'rdlai2d =',rdlai2d - !endif - !endif + endif + endif !> - Call RUC LSM lsmruc(). call lsmruc( delt, flag_init, flag_restart, kdt, iter, nsoil, & @@ -977,8 +977,8 @@ subroutine lsm_ruc_run & ! inputs & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte ) - !if(debug_print) then - !if(i==ipr) then + if(debug_print) then + if(i==ipr) then write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) @@ -1013,8 +1013,8 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'after snfallac(i,j) =',i,j,snfallac(i,j) write (0,*)'after acsn(i,j) =',i,j,acsn(i,j) write (0,*)'after snomlt(i,j) =',i,j,snomlt(i,j) - !endif - !endif + endif + endif !> - RUC LSM: prepare variables for return to parent model and unit conversion. @@ -1320,8 +1320,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in flag_soil_levels = 1 ! =1 for input from RUC LSM else ! for Noah input set smadj and swi_init to .true. - smadj = .false. - swi_init = .false. + smadj = .true. + swi_init = .true. flag_soil_layers = 1 ! =1 for input from the Noah LSM flag_soil_levels = 0 ! =1 for input from RUC LSM endif @@ -1358,18 +1358,18 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do i=its,ite ! i = horizontal loop sst(i,j) = tskin_wat(i) - tbot(i,j)= tg3(i) - ivgtyp(i,j)=vegtype(i) - isltyp(i,j)=soiltyp(i) + tbot(i,j) = tg3(i) + ivgtyp(i,j) = vegtype(i) + isltyp(i,j) = soiltyp(i) if (land(i) .or. icy(i)) then !-- land or ice tsk(i,j) = tskin_lnd(i) landmask(i,j)=1. - else - !-- water + else + !-- water tsk(i,j) = tskin_wat(i) landmask(i,j)=0. - endif ! land(i) + endif ! land(i) enddo enddo @@ -1382,13 +1382,19 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in st_input(i,1,j)=tsk(i,j) sm_input(i,1,j)=0. + !--- initialize smcwlt2 and smcref2 with Noah values + if(land(i)) then + smcref2 (i) = REFSMCnoah(soiltyp(i)) + smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) + else + smcref2 (i) = 1. + smcwlt2 (i) = 0. + endif + do k=1,lsoil st_input(i,k+1,j)=stc(i,k) ! convert volumetric soil moisture to SWI (soil wetness index) if(land(i) .and. swi_init) then - !--- initialize smcwlt2 and smcref2 with Noah values - smcref2 (i) = REFSMCnoah(soiltyp(i)) - smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ & (smcref2(i) - smcwlt2(i)))) else @@ -1579,14 +1585,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in enddo endif ! frac_grid - !if(debug_print) then + if(debug_print) then do i=1,im write (0,*)'End of RUC LSM initialization' write (0,*)'tslb(i)=',i,land(i),icy(i),tslb(i,:) write (0,*)'smois(i)=',i,land(i),icy(i),smois(i,:) write (0,*)'wetness(i)=',i,land(i),icy(i),wetness(i) enddo - !endif ! debug_print + endif ! debug_print end subroutine rucinit From 6e33a576148174ac89559bbc0d44a3a32cc26f1e Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 14 Sep 2020 20:10:52 +0000 Subject: [PATCH 88/97] A syntax error is corrected. --- physics/sfc_drv_ruc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 6debf4522..8004bc7f9 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -170,7 +170,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !-- land soiltyp(i) = int( stype(i)+0.5 ) vegtype(i) = int( vtype(i)+0.5 ) - elseif( icy(i) > 0. ) then + elseif( icy(i) ) then !-- ice if (isot == 1) then soiltyp(i) = 16 From 985ca4fcf164a0c5cfb529faaf4b9b3cfdea4ecd Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 15 Sep 2020 19:16:05 +0000 Subject: [PATCH 89/97] Fractional grid is removed from the RUC soil initialization, since the goal here is just a vertical interpolation from 4-layer t0 9-level data. --- physics/module_sf_ruclsm.F90 | 22 ++--- physics/sfc_drv_ruc.F90 | 184 ++++++++++------------------------- physics/sfc_drv_ruc.meta | 70 ------------- 3 files changed, 61 insertions(+), 215 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 1a7037cf7..024f97772 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -7022,7 +7022,7 @@ END SUBROUTINE SOILVEGIN !> This subroutine computes liquid and forezen soil moisture from the !! total soil moisture, and also computes soil moisture availability in !! the top soil layer. - SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & + SUBROUTINE RUCLSMINIT( debug_print, slmsk, & nzs, isltyp, ivgtyp, mavail, & sh2o, smfr3d, tslb, smois, & ims,ime, jms,jme, kms,kme, & @@ -7035,8 +7035,7 @@ SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & #endif IMPLICIT NONE LOGICAL, INTENT(IN ) :: debug_print - LOGICAL, INTENT(IN ) :: frac_grid - LOGICAL, DIMENSION( ims:ime), INTENT(IN ) :: land, icy + REAL, DIMENSION( ims:ime), INTENT(IN ) :: slmsk INTEGER, INTENT(IN ) :: & ims,ime, jms,jme, kms,kme, & @@ -7095,11 +7094,11 @@ SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & ! in Zobler classification isltyp=0 for water. Statsgo classification ! has isltyp=14 for water if (isltyp(i,j) == 0) isltyp(i,j)=14 - - if(land(i) ) then - !--- Computation of volumetric content of ice in soil - !--- and initialize MAVAIL + if(slmsk(i) == 1. ) then + !-- land + !-- Computate volumetric content of ice in soil + !-- and initialize MAVAIL DQM = MAXSMC (ISLTYP(I,J)) - & DRYSMC (ISLTYP(I,J)) REF = REFSMC (ISLTYP(I,J)) @@ -7129,24 +7128,23 @@ SUBROUTINE RUCLSMINIT( debug_print, frac_grid, land, icy, & endif ENDDO - elseif( icy(i) .and. .not. frac_grid ) then + elseif( slmsk(i) == 2.) then !-- ice + mavail(i,j) = 1. DO L=1,NZS smfr3d(i,l,j)=1. sh2o(i,l,j)=0. - mavail(i,j) = 1. ENDDO - elseif( .not. frac_grid) then + else !-- water ISLTYP=14 + mavail(i,j) = 1. DO L=1,NZS smfr3d(i,l,j)=0. sh2o(i,l,j)=1. - mavail(i,j) = 1. ENDDO endif ! land - !ENDIF ENDDO ENDDO diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 8004bc7f9..5370cd763 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -28,12 +28,9 @@ module lsm_ruc subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, & im, lsoil_ruc, lsoil, kice, nlev, & ! in - lsm_ruc, lsm, slmsk, landfrac, & ! in - stype, vtype, frac_grid, & ! in - flag_cice, min_seaice, min_lakeice, & - fice, tsfc_lnd, tsfc_wat, & + lsm_ruc, lsm, slmsk, stype, vtype, & ! in + tsfc_lnd, tsfc_wat, & ! in tg3, smc, slc, stc, & ! in - smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, wetness, & ! out tsice, errmsg, errflg) @@ -42,7 +39,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & integer, intent(in) :: me, master, isot, ivegsrc, nlunit logical, intent(in) :: flag_restart logical, intent(in) :: flag_init - logical, intent(in) :: frac_grid integer, intent(in) :: im integer, intent(in) :: lsoil_ruc integer, intent(in) :: lsoil @@ -52,11 +48,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im), intent(in ) :: slmsk - real (kind=kind_phys), dimension(im), intent(in ) :: landfrac real (kind=kind_phys), dimension(im), intent(in ) :: stype real (kind=kind_phys), dimension(im), intent(in ) :: vtype - logical, dimension(im), intent(in ) :: flag_cice - real (kind=kind_phys), intent(in ) :: min_lakeice, min_seaice real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_lnd real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_wat real (kind=kind_phys), dimension(im), intent(in) :: tg3 @@ -64,9 +57,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im,lsoil), intent(in) :: smc,slc,stc ! --- in/out: - real (kind=kind_phys), dimension(im), intent(inout) :: fice real (kind=kind_phys), dimension(im), intent(inout) :: wetness - real (kind=kind_phys), dimension(im), intent(inout) :: smcref2, smcwlt2 ! --- out real (kind=kind_phys), dimension(im,lsoil_ruc), intent(out) :: sh2o, smfrkeep @@ -79,9 +70,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- local integer :: ipr, i, k logical :: debug_print - logical, dimension(im) :: land, icy, wet integer, dimension(im) :: soiltyp, vegtype - real (kind=kind_phys), dimension(im) :: frland ! Initialize CCPP error handling variables errmsg = '' @@ -100,7 +89,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & write (0,*) 'noah mois(ipr)',ipr,smc(ipr,:) write (0,*) 'stype=',stype(ipr) write (0,*) 'vtype=',vtype(ipr) - write (0,*) 'fice=',fice(ipr) write (0,*) 'tsfc_lnd=',tsfc_lnd(ipr) write (0,*) 'tsfc_wat=',tsfc_wat(ipr) write (0,*) 'tg3=',tg3(ipr) @@ -114,63 +102,9 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & soiltyp(:) = 0 vegtype(:) = 0 - land (:) = .false. - icy (:) = .false. - wet (:) = .false. - - if (frac_grid) then ! fice is ice fraction wrt water area - do i=1,im - frland(i) = landfrac(i) - if (frland(i) > zero) land(i) = .true. - if (frland(i) < one) then - if (flag_cice(i)) then - if (fice(i) >= min_seaice) then - icy(i) = .true. - else - fice(i) = zero - endif - else - if (fice(i) >= min_lakeice) then - icy(i) = .true. - else - fice(i) = zero - endif - endif - if (fice(i) < one ) then - wet(i)=.true. ! some open ocean/lake water exists - end if - else - fice(i) = zero - endif - enddo - - else - - do i = 1, IM - frland(i) = zero - if (slmsk(i) == 0) then - wet(i) = .true. - fice(i) = zero - elseif (slmsk(i) == 1) then - land(i) = .true. - frland(i) = one - fice(i) = zero - else - icy(i) = .true. - if (fice(i) < one) then - wet(i) = .true. - endif - endif - enddo - - endif do i = 1, im ! i - horizontal loop - if( land(i) ) then - !-- land - soiltyp(i) = int( stype(i)+0.5 ) - vegtype(i) = int( vtype(i)+0.5 ) - elseif( icy(i) ) then + if (slmsk(i) == 2.) then !-- ice if (isot == 1) then soiltyp(i) = 16 @@ -182,8 +116,10 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & elseif(ivegsrc == 2) then vegtype(i) = 13 endif - elseif ( wet(i) ) then - !-- water + else + !-- land or water + soiltyp(i) = int( stype(i)+0.5 ) + vegtype(i) = int( vtype(i)+0.5 ) if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 endif @@ -192,11 +128,9 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & if( .not. flag_restart) then call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in - frac_grid, land, icy, & ! in - soiltyp, vegtype, fice, & ! in + soiltyp, vegtype, & ! in tsfc_lnd, tsfc_wat, tg3, & ! in smc, slc, stc, & ! in - smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) @@ -1182,11 +1116,9 @@ end subroutine lsm_ruc_run !! This subroutine contains RUC LSM initialization. subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in - frac_grid, land, icy, & ! in - soiltyp, vegtype, fice, & ! in + soiltyp, vegtype, & ! in tskin_lnd, tskin_wat, tg3, & ! !in smc, slc, stc, & ! in - smcref2, smcwlt2, & ! inout sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) @@ -1198,12 +1130,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, intent(in ) :: im, nlev integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil - logical, intent(in ) :: frac_grid - logical, dimension(im), intent(in ) :: land, icy real (kind=kind_phys), dimension(im), intent(in ) :: slmsk real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat - real (kind=kind_phys), dimension(im), intent(inout) :: smcref2 - real (kind=kind_phys), dimension(im), intent(inout) :: smcwlt2 real (kind=kind_phys), dimension(im), intent(in ) :: tg3 real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: smc ! Noah real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: stc ! Noah @@ -1212,7 +1140,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, dimension(im), intent(inout) :: soiltyp integer, dimension(im), intent(inout) :: vegtype real (kind=kind_phys), dimension(im), intent(inout) :: wetness - real (kind=kind_phys), dimension(im), intent(in ) :: fice real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smois! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb ! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: sh2o ! ruc @@ -1229,8 +1156,10 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in logical :: swi_init ! for initialization in terms of SWI (soil wetness index) integer :: flag_soil_layers, flag_soil_levels, flag_sst - real (kind=kind_phys), dimension(1:lsoil_ruc) :: factorsm + real (kind=kind_phys), dimension(1:lsoil_ruc) :: factorsm real (kind=kind_phys), dimension(1:lsoil_ruc) :: zs + real (kind=kind_phys), dimension(im) :: smcref2 + real (kind=kind_phys), dimension(im) :: smcwlt2 integer , dimension( 1:im , 1:1 ) :: ivgtyp integer , dimension( 1:im , 1:1) :: isltyp @@ -1361,14 +1290,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in tbot(i,j) = tg3(i) ivgtyp(i,j) = vegtype(i) isltyp(i,j) = soiltyp(i) - if (land(i) .or. icy(i)) then - !-- land or ice - tsk(i,j) = tskin_lnd(i) - landmask(i,j)=1. - else + if (slmsk(i) == 0.) then !-- water tsk(i,j) = tskin_wat(i) landmask(i,j)=0. + else + !-- land or ice + tsk(i,j) = tskin_lnd(i) + landmask(i,j)=1. endif ! land(i) enddo @@ -1383,18 +1312,18 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in sm_input(i,1,j)=0. !--- initialize smcwlt2 and smcref2 with Noah values - if(land(i)) then - smcref2 (i) = REFSMCnoah(soiltyp(i)) - smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) + if(slmsk(i) == 1.) then + smcref2 (i) = REFSMCnoah(soiltyp(i)) + smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) else - smcref2 (i) = 1. - smcwlt2 (i) = 0. + smcref2 (i) = 1. + smcwlt2 (i) = 0. endif do k=1,lsoil st_input(i,k+1,j)=stc(i,k) ! convert volumetric soil moisture to SWI (soil wetness index) - if(land(i) .and. swi_init) then + if(slmsk(i) == 1. .and. swi_init) then sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ & (smcref2(i) - smcwlt2(i)))) else @@ -1429,23 +1358,26 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - if (land(i)) then + if (slmsk(i) == 1.) then + !-- land do k=1,lsoil_ruc ! convert from SWI to RUC volumetric soil moisture if(swi_init) then - soilm(i,k,j)= dumsm(i,k,j) * & + soilm(i,k,j) = dumsm(i,k,j) * & (refsmc(isltyp(i,j))-drysmc(isltyp(i,j))) & + drysmc(isltyp(i,j)) else - soilm(i,k,j)= dumsm(i,k,j) + soilm(i,k,j) = dumsm(i,k,j) endif soiltemp(i,k,j) = dumt(i,k,j) enddo ! k - elseif (icy(i)) then + else + !-- ice or water do k=1,lsoil_ruc + soilm(i,k,j) = 1. soiltemp(i,k,j) = dumt(i,k,j) enddo ! k - endif ! land(i) + endif ! land enddo enddo @@ -1467,7 +1399,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - if (land(i)) then + if (slmsk(i) == 1.) then ! initialize factor do k=1,lsoil_ruc @@ -1544,7 +1476,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! and soil temperature, and also soil moisture availability in the top ! layer - call ruclsminit( debug_print, frac_grid, land, icy, & + call ruclsminit( debug_print, slmsk, & lsoil_ruc, isltyp, ivgtyp, mavail, & soilh2o, smfr, soiltemp, soilm, & ims,ime, jms,jme, kms,kme, & @@ -1552,45 +1484,31 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - if (land(i)) then - wetness(i) = mavail(i,j) - do k = 1, lsoil_ruc - smois(i,k) = soilm(i,k,j) - tslb(i,k) = soiltemp(i,k,j) - sh2o(i,k) = soilh2o(i,k,j) - smfrkeep(i,k) = smfr(i,k,j) - enddo - elseif (icy(i)) then - wetness (i) = 1. - do k = 1, lsoil_ruc - smois(i,k) = 1. - tslb(i,k) = soiltemp(i,k,j) - sh2o(i,k) = 0. - smfrkeep(i,k) = 1. - enddo - endif ! land(i) + wetness(i) = mavail(i,j) + do k = 1, lsoil_ruc + smois(i,k) = soilm(i,k,j) + tslb(i,k) = soiltemp(i,k,j) + sh2o(i,k) = soilh2o(i,k,j) + smfrkeep(i,k) = smfr(i,k,j) + enddo enddo enddo - if (.not. frac_grid) then - do i=1,im - if (.not.land(i) .and. .not.icy(i)) then - wetness (i) = 1. - do k=1,min(lsoil,lsoil_ruc) - smois(i,k) = smc(i,k) - tslb(i,k) = stc(i,k) - sh2o(i,k) = slc(i,k) - enddo - endif - enddo - endif ! frac_grid + !do i=1,im + ! wetness (i) = 1. + ! do k=1,min(lsoil,lsoil_ruc) + ! smois(i,k) = smc(i,k) + ! tslb(i,k) = stc(i,k) + ! sh2o(i,k) = slc(i,k) + ! enddo + !enddo if(debug_print) then do i=1,im write (0,*)'End of RUC LSM initialization' - write (0,*)'tslb(i)=',i,land(i),icy(i),tslb(i,:) - write (0,*)'smois(i)=',i,land(i),icy(i),smois(i,:) - write (0,*)'wetness(i)=',i,land(i),icy(i),wetness(i) + write (0,*)'tslb(i)=',i,tslb(i,:) + write (0,*)'smois(i)=',i,smois(i,:) + write (0,*)'wetness(i)=',i,wetness(i) enddo endif ! debug_print diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 3441111e5..53bc48fdd 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -122,15 +122,6 @@ kind = kind_phys intent = in optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [stype] standard_name = soil_type_classification_real long_name = soil type for lsm @@ -149,49 +140,6 @@ kind = kind_phys intent = inout optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in - optional = F -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = ??? - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[min_lakeice] - standard_name = lake_ice_minimum - long_name = minimum lake ice value - units = ??? - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [tsfc_lnd] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -246,24 +194,6 @@ kind = kind_phys intent = in optional = F -[smcref2] - standard_name = threshold_volume_fraction_of_condensed_water_in_soil - long_name = soil moisture threshold - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[smcwlt2] - standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point - long_name = soil water fraction at wilting point - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [sh2o] standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm From a8d1b6bc4aa989baba622025add3b6f47e694bdb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 23 Sep 2020 11:20:21 -0600 Subject: [PATCH 90/97] Update standard names for flags/controls of cloud overlap methods --- physics/GFS_rrtmg_setup.meta | 4 ++-- physics/GFS_rrtmgp_setup.meta | 4 ++-- physics/module_SGSCloud_RadPre.meta | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8377807d8..fec7e32d0 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -113,7 +113,7 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + standard_name = flag_for_cloud_overlap_method_for_shortwave_radiation long_name = sw: max-random overlap clouds units = flag dimensions = () @@ -121,7 +121,7 @@ intent = in optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + standard_name = flag_for_cloud_overlap_method_for_longwave_radiation long_name = lw: max-random overlap clouds units = flag dimensions = () diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 430226dbc..45e9d65a2 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -161,7 +161,7 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + standard_name = flag_for_cloud_overlap_method_for_shortwave_radiation long_name = sw: max-random overlap clouds units = flag dimensions = () @@ -169,7 +169,7 @@ intent = in optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + standard_name = flag_for_cloud_overlap_method_for_longwave_radiation long_name = lw: max-random overlap clouds units = flag dimensions = () diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 94c9e78e9..f7db379d7 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -338,7 +338,7 @@ intent = in optional = F [iovr] - standard_name = flag_for_max_random_overlap_clouds_for_radiation + standard_name = flag_for_cloud_overlap_method_for_radiation long_name = max-random overlap clouds units = flag dimensions = () From 44e298aa7c3b0275c71450588fad0837a1b7f895 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 24 Sep 2020 16:29:40 +0000 Subject: [PATCH 91/97] Removed if(.not. restart) around the call to rucinit. --- physics/sfc_drv_ruc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 5370cd763..d54561d21 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -125,7 +125,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & endif enddo - if( .not. flag_restart) then + !if( .not. flag_restart) then call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in soiltyp, vegtype, & ! in @@ -142,7 +142,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & enddo enddo ! i - endif ! flag_restart + !endif ! flag_restart !-- end of initialization if ( debug_print) then From e177dca0e3e79220939367580ce0c15b61e72089 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 28 Sep 2020 09:11:14 -0600 Subject: [PATCH 92/97] add CMakeLists.txt change from @climbfuji --- CMakeLists.txt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 06ca63d0b..a18f0b0f3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -212,7 +212,9 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") endif() # Remove files with special compiler flags from list of files with standard compiler flags - list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) + if (SCHEMES_SFX_OPT) + list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) + endif(SCHEMES_SFX_OPT) # Assign standard compiler flags to all remaining schemes and caps SET_SOURCE_FILES_PROPERTIES(${SCHEMES} ${CAPS} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT}") From 52c4f54ef093836d73c664780274deb999b402e2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 1 Oct 2020 15:41:39 -0600 Subject: [PATCH 93/97] Remove switch between WRFv3.8.1 and v4+ in module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 65 +++------------------------------- 1 file changed, 4 insertions(+), 61 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 304afc6d5..14604e625 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1,12 +1,6 @@ !>\file module_mp_thompson.F90 !! This file contains the entity of GSD Thompson MP scheme. -! DH* 2020-06-05 -! Use the following preprocessor directive to roll back -! to the WRFv3.8.1, used in RAPv5/HRRRv4 for more reasonable -! representation of mesoscale storms and reflectivity values -!#define WRF381 - !>\ingroup aathompson !! This module computes the moisture tendencies of water vapor, @@ -463,13 +457,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & if (.NOT. ALLOCATED(tcg_racg) ) then ALLOCATE(tcg_racg(ntb_g1,ntb_g,ntb_r1,ntb_r)) micro_init = .TRUE. - if (mpirank==mpiroot) then -#ifdef WRF381 - write(0,*) "Using Thompson MP from WRFv3.8.1 (RAPv5/HRRRv4)" -#else - write(0,*) "Using Thompson MP from WRFv4.0+" -#endif - endif endif if (.NOT. ALLOCATED(tmr_racg)) ALLOCATE(tmr_racg(ntb_g1,ntb_g,ntb_r1,ntb_r)) @@ -2715,13 +2702,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !! supersat again. sump = pri_inu(k) + pri_ide(k) + prs_ide(k) & + prs_sde(k) + prg_gde(k) + pri_iha(k) -! DH* 2020-06-02 I believe that the WRF381 version -! is wrong, because the units do not match. -#ifdef WRF381 - rate_max = (qv(k)-qvsi(k))*odts*0.999 -#else rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.999 -#endif if ( (sump.gt. eps .and. sump.gt. rate_max) .or. & (sump.lt. -eps .and. sump.lt. rate_max) ) then ratio = rate_max/sump @@ -3598,7 +3579,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(1)) enddo -#ifdef WRF381 +#if 1 if (rr(kts).gt.R1*10.) & #else if (rr(kts).gt.R1*1000.) & @@ -3653,7 +3634,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(2)) enddo -#ifdef WRF381 +#if 1 if (ri(kts).gt.R1*10.) & #else if (ri(kts).gt.R1*1000.) & @@ -3684,7 +3665,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(3)) enddo -#ifdef WRF381 +#if 1 if (rs(kts).gt.R1*10.) & #else if (rs(kts).gt.R1*1000.) & @@ -3715,7 +3696,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(4)) enddo -#ifdef WRF381 +#if 1 if (rg(kts).gt.R1*10.) & #else if (rg(kts).gt.R1*1000.) & @@ -3760,21 +3741,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qv1d(k) = MAX(1.E-10, qv1d(k) + qvten(k)*DT) qc1d(k) = qc1d(k) + qcten(k)*DT nc1d(k) = MAX(2./rho(k), MIN(nc1d(k) + ncten(k)*DT, Nt_c_max)) -! DH* 2020-06-05 I believe WRF381 is wrong in terms of units; -! dividing by rho turns number concentration per volume into -! number concentration per mass. -#ifdef WRF381 nwfa1d(k) = MAX(11.1E6/rho(k), MIN(9999.E6/rho(k), & (nwfa1d(k)+nwfaten(k)*DT))) nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6/rho(k), & (nifa1d(k)+nifaten(k)*DT))) -#else - nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & - (nwfa1d(k)+nwfaten(k)*DT))) - nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & - (nifa1d(k)+nifaten(k)*DT))) -#endif - if (qc1d(k) .le. R1) then qc1d(k) = 0.0 nc1d(k) = 0.0 @@ -5275,31 +5245,14 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & ! are consistent with the WRFv3.8.1 settings, but inconsistent ! with the WRFv4+ settings. In order to apply the same bounds ! as before this change, use the WRF v3.8.1 settings throughout. -#if 1 -!ifdef WRF381 re_qc1d(:) = 2.49E-6 re_qi1d(:) = 4.99E-6 re_qs1d(:) = 9.99E-6 -#else - re_qc1d(:) = 2.49E-6 - re_qi1d(:) = 2.49E-6 - re_qs1d(:) = 4.99E-6 -#endif do k = kts, kte rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) rc(k) = MAX(R1, qc1d(k)*rho(k)) -#ifdef WRF381 - nc(k) = MAX(R2, MIN(nc1d(k)*rho(k), Nt_c_max)) -#else - ! DH* 2020-06-05 is using 2.0 instead of R2 - ! a bug in the WRFv4.0+ version of Thompson? - ! For ni(k) a few lines below, it is still R2. - ! Note that R2 is defined as R2 = 1.E-6, and is - ! used in other parts of Thompson MP for ni/nr - ! calculations (but not for nc calculations) nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) -#endif if (.NOT. is_aerosol_aware) nc(k) = Nt_c if (rc(k).gt.R1 .and. nc(k).gt.R2) has_qc = .true. ri(k) = MAX(R1, qi1d(k)*rho(k)) @@ -5328,12 +5281,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & do k = kts, kte if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi -#if 1 -!ifdef WRF381 re_qi1d(k) = MAX(5.01E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) -#else - re_qi1d(k) = MAX(2.51E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) -#endif enddo endif @@ -5373,12 +5321,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & & + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) & & + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1) smoc = a_ * smo2**b_ -#if 1 -!ifdef WRF381 re_qs1d(k) = MAX(10.E-6, MIN(0.5*(smoc/smob), 999.E-6)) -#else - re_qs1d(k) = MAX(5.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) -#endif enddo endif From 2b4141930ce13c2f8e5e750c9bbe5da622f45a3e Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 13 Oct 2020 19:30:43 +0000 Subject: [PATCH 94/97] If restart=.true. do not set XLAI=0 in the initialization. --- physics/sfc_drv_ruc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index d54561d21..a8f975aa2 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -419,7 +419,7 @@ subroutine lsm_ruc_run & ! inputs if(flag_init .and. iter==1) then ! Initialize the RUC soil levels, needed for cold starts and warm starts CALL init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - xlai = 0. + if (.not. restart) !xlai = 0. endif ! flag_init=.true.,iter=1 ims = 1 From 762beebb2337d94ba455837a1467b8f5f1857ba3 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 13 Oct 2020 19:35:08 +0000 Subject: [PATCH 95/97] Corrected syntax error. --- physics/sfc_drv_ruc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index a8f975aa2..6626d8fb6 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -419,7 +419,7 @@ subroutine lsm_ruc_run & ! inputs if(flag_init .and. iter==1) then ! Initialize the RUC soil levels, needed for cold starts and warm starts CALL init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - if (.not. restart) !xlai = 0. + if (.not. restart) xlai = 0. endif ! flag_init=.true.,iter=1 ims = 1 From 7d6d8ce473297eed5224cd3a52a1ddffbbe41b9b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 14 Oct 2020 09:15:53 -0600 Subject: [PATCH 96/97] Add capability to print debugging output for all blocks and threads in init phase --- physics/GFS_debug.F90 | 63 +++++++++++++++++++++++++++-- physics/GFS_debug.meta | 92 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 152 insertions(+), 3 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 35b44ca0e..4680f8de7 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -311,7 +311,37 @@ module GFS_diagtoscreen contains - subroutine GFS_diagtoscreen_init () +!> \section arg_table_GFS_diagtoscreen_init Argument Table +!! \htmlinclude GFS_diagtoscreen_init.html +!! + subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,size(Data) + call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & + Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & + Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & + size(Interstitial), i, errmsg, errflg) + end do + end subroutine GFS_diagtoscreen_init subroutine GFS_diagtoscreen_finalize () @@ -330,7 +360,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #ifdef OPENMP use omp_lib #endif - use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & GFS_stateout_type, GFS_sfcprop_type, & GFS_coupling_type, GFS_grid_type, & @@ -831,7 +860,35 @@ module GFS_interstitialtoscreen contains - subroutine GFS_interstitialtoscreen_init () + subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + + do i=1,size(Interstitial) + call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & + Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & + Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + size(Interstitial), -999, errmsg, errflg) + end do + end subroutine GFS_interstitialtoscreen_init subroutine GFS_interstitialtoscreen_finalize () diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index d93e22328..6e6315d5b 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -3,6 +3,52 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = GFS_diagtoscreen_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_diagtoscreen_run @@ -135,6 +181,52 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = GFS_interstitialtoscreen_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_interstitialtoscreen_run From 05b9aba6cad4760c5f5fdd9e55e8485a88c28674 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 14 Oct 2020 09:19:17 -0600 Subject: [PATCH 97/97] Fix RUC LSM initialization --- physics/sfc_drv_ruc.F90 | 123 +++++++++++++++++---------------------- physics/sfc_drv_ruc.meta | 21 +++++-- 2 files changed, 68 insertions(+), 76 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 6626d8fb6..7af8c3497 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -31,7 +31,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & lsm_ruc, lsm, slmsk, stype, vtype, & ! in tsfc_lnd, tsfc_wat, & ! in tg3, smc, slc, stc, & ! in - sh2o, smfrkeep, tslb, smois, wetness, & ! out + zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out tsice, errmsg, errflg) implicit none @@ -47,12 +47,12 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & integer, intent(in) :: lsm_ruc, lsm - real (kind=kind_phys), dimension(im), intent(in ) :: slmsk - real (kind=kind_phys), dimension(im), intent(in ) :: stype - real (kind=kind_phys), dimension(im), intent(in ) :: vtype - real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_lnd - real (kind=kind_phys), dimension(im), intent(in ) :: tsfc_wat - real (kind=kind_phys), dimension(im), intent(in) :: tg3 + real (kind=kind_phys), dimension(im), intent(in) :: slmsk + real (kind=kind_phys), dimension(im), intent(in) :: stype + real (kind=kind_phys), dimension(im), intent(in) :: vtype + real (kind=kind_phys), dimension(im), intent(in) :: tsfc_lnd + real (kind=kind_phys), dimension(im), intent(in) :: tsfc_wat + real (kind=kind_phys), dimension(im), intent(in) :: tg3 real (kind=kind_phys), dimension(im,lsoil), intent(in) :: smc,slc,stc @@ -60,14 +60,16 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im), intent(inout) :: wetness ! --- out - real (kind=kind_phys), dimension(im,lsoil_ruc), intent(out) :: sh2o, smfrkeep - real (kind=kind_phys), dimension(im,lsoil_ruc), intent(out) :: tslb, smois + real (kind=kind_phys), dimension(:), intent(out) :: zs + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: sh2o, smfrkeep + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb, smois real (kind=kind_phys), dimension(im,kice), intent(out) :: tsice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- local + real (kind=kind_phys), dimension(lsoil_ruc) :: dzs integer :: ipr, i, k logical :: debug_print integer, dimension(im) :: soiltyp, vegtype @@ -125,14 +127,16 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & endif enddo + call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) + !if( .not. flag_restart) then call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in - me, master, lsm_ruc, lsm, slmsk, & ! in - soiltyp, vegtype, & ! in - tsfc_lnd, tsfc_wat, tg3, & ! in - smc, slc, stc, & ! in - sh2o, smfrkeep, tslb, smois, & ! out - wetness, errmsg, errflg) + me, master, lsm_ruc, lsm, slmsk, & ! in + soiltyp, vegtype, & ! in + tsfc_lnd, tsfc_wat, tg3, & ! in + zs, dzs, smc, slc, stc, & ! in + sh2o, smfrkeep, tslb, smois, & ! out + wetness, errmsg, errflg) do i = 1, im ! i - horizontal loop do k = 1, min(kice,lsoil_ruc) @@ -146,10 +150,10 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !-- end of initialization if ( debug_print) then - write (0,*) 'ruc soil tslb',tslb(:,1) - write (0,*) 'ruc soil tsice',tsice(:,1) - write (0,*) 'ruc soil smois',smois(:,1) - write (0,*) 'ruc wetness',wetness(:) + write (0,*) 'ruc soil tslb',tslb(ipr,:) + write (0,*) 'ruc soil tsice',tsice(ipr,:) + write (0,*) 'ruc soil smois',smois(ipr,:) + write (0,*) 'ruc wetness',wetness(ipr) endif end subroutine lsm_ruc_init @@ -303,8 +307,7 @@ subroutine lsm_ruc_run & ! inputs ! --- in/out: integer, dimension(im), intent(inout) :: soiltyp, vegtype - real (kind=kind_phys), dimension(lsoil_ruc) :: dzs - real (kind=kind_phys), dimension(lsoil_ruc), intent(inout ) :: zs + real (kind=kind_phys), dimension(lsoil_ruc), intent(in) :: zs real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & & snwdph, tskin, tskin_wat, & & srflag, canopy, trans, tsurf, zorl, tsnow, & @@ -415,12 +418,6 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'flag_init =',flag_init write (0,*)'flag_restart =',flag_restart endif - - if(flag_init .and. iter==1) then - ! Initialize the RUC soil levels, needed for cold starts and warm starts - CALL init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - if (.not. restart) xlai = 0. - endif ! flag_init=.true.,iter=1 ims = 1 its = 1 @@ -705,7 +702,11 @@ subroutine lsm_ruc_run & ! inputs albbck(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) alb(i,j) = sfalb(i) - if(rdlai2d) xlai(i,j) = laixy(i) + if(rdlai2d) then + xlai(i,j) = laixy(i) + else + xlai(i,j) = 0. + endif tbot(i,j) = tg3(i) @@ -1082,30 +1083,14 @@ subroutine lsm_ruc_run & ! inputs deallocate(landusef) ! !! Update standard (Noah LSM) soil variables for physics - !! that require these variables (e.g. sfc_sice), independent - !! of whether it is a land point or not - !do i = 1, im - ! if (land(i)) then - ! do k = 1, lsoil - ! smc(i,k) = smois(i,k) - ! slc(i,k) = sh2o(i,k) - ! stc(i,k) = tslb(i,k) - ! enddo - ! endif - !enddo - ! - !write(0,*) "DH DEBUG: i, k, land(i), smc(i,k), slc(i,k), stc(i,k):" - !do i = 1, im - ! do k = 1, lsoil - ! write(0,'(2i5,1x,l,1x,3e20.10)'), i, k, land(i), smc(i,k), slc(i,k), stc(i,k) - ! smc(i,k) = smois(i,k) - ! slc(i,k) = sh2o(i,k) - ! stc(i,k) = tslb(i,k) - ! enddo - !enddo - - !call sleep(20) - !stop + !! that require these variables and for debugging purposes + do i = 1, im + do k = 1, lsoil + smc(i,k) = smois(i,k) + slc(i,k) = sh2o(i,k) + stc(i,k) = tslb(i,k) + enddo + enddo return !................................... @@ -1118,24 +1103,26 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in soiltyp, vegtype, & ! in tskin_lnd, tskin_wat, tg3, & ! !in - smc, slc, stc, & ! in + zs, dzs, smc, slc, stc, & ! in sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) implicit none - logical, intent(in ) :: restart - integer, intent(in ) :: lsm - integer, intent(in ) :: lsm_ruc - integer, intent(in ) :: im, nlev - integer, intent(in ) :: lsoil_ruc - integer, intent(in ) :: lsoil - real (kind=kind_phys), dimension(im), intent(in ) :: slmsk - real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat - real (kind=kind_phys), dimension(im), intent(in ) :: tg3 - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: smc ! Noah - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: stc ! Noah - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: slc ! Noah + logical, intent(in ) :: restart + integer, intent(in ) :: lsm + integer, intent(in ) :: lsm_ruc + integer, intent(in ) :: im, nlev + integer, intent(in ) :: lsoil_ruc + integer, intent(in ) :: lsoil + real (kind=kind_phys), dimension(im), intent(in ) :: slmsk + real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat + real (kind=kind_phys), dimension(im), intent(in ) :: tg3 + real (kind=kind_phys), dimension(1:lsoil_ruc), intent(in ) :: zs + real (kind=kind_phys), dimension(1:lsoil_ruc), intent(in ) :: dzs + real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: smc ! Noah + real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: stc ! Noah + real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: slc ! Noah integer, dimension(im), intent(inout) :: soiltyp integer, dimension(im), intent(inout) :: vegtype @@ -1157,7 +1144,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer :: flag_soil_layers, flag_soil_levels, flag_sst real (kind=kind_phys), dimension(1:lsoil_ruc) :: factorsm - real (kind=kind_phys), dimension(1:lsoil_ruc) :: zs real (kind=kind_phys), dimension(im) :: smcref2 real (kind=kind_phys), dimension(im) :: smcwlt2 @@ -1185,7 +1171,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in its,ite, jts,jte, kts,kte, & i, j, k, l, num_soil_layers, ipr - real(kind=kind_phys), dimension(1:lsoil_ruc) :: zs2, dzs integer, dimension(1:lsoil) :: st_levels_input ! 4 - for Noah lsm integer, dimension(1:lsoil) :: sm_levels_input ! 4 - for Noah lsm @@ -1205,6 +1190,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in else if (debug_print) then write (0,*) 'Start of RUC LSM initialization' write (0,*)'lsoil, lsoil_ruc =',lsoil, lsoil_ruc + write (0,*)'restart = ',restart endif ipr = 10 @@ -1229,9 +1215,6 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in kme = nlev kte = nlev - ! Initialize the RUC soil levels, needed for cold starts and warm starts - CALL init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - !! Check if RUC soil data (tslb, ...) is provided or not !if (minval(tslb)==maxval(tslb)) then ! For restart runs, can assume that RUC soul data is provided diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 509c22588..8737f0d60 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -200,6 +200,15 @@ kind = kind_phys intent = in optional = F +[zs] + standard_name = depth_of_soil_levels_for_land_surface_model + long_name = depth of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = out + optional = F [sh2o] standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm @@ -207,7 +216,7 @@ dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys - intent = out + intent = inout optional = F [smfrkeep] standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model @@ -216,7 +225,7 @@ dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys - intent = out + intent = inout optional = F [tslb] standard_name = soil_temperature_for_land_surface_model @@ -225,7 +234,7 @@ dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys - intent = out + intent = inout optional = F [smois] standard_name = volume_fraction_of_soil_moisture_for_land_surface_model @@ -234,7 +243,7 @@ dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys - intent = out + intent = inout optional = F [wetness] standard_name = normalized_soil_wetness_for_land_surface_model @@ -243,7 +252,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsice] standard_name = internal_ice_temperature @@ -369,7 +378,7 @@ dimensions = (soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys - intent = inout + intent = in optional = F [t1] standard_name = air_temperature_at_lowest_model_layer