From b33d1991b3e5ac249b2789e3f564e97c3cf1d505 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 21 Dec 2020 10:00:55 -0600 Subject: [PATCH 1/5] established merra2 and a bug fixed in radiation_aerosols.f --- physics/radiation_aerosols.f | 2 + physics/samfdeepcnv.f | 138 +++++++++++++++++------------------ physics/sfc_sice.f | 8 +- 3 files changed, 75 insertions(+), 73 deletions(-) diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index f732c37ef..130c6471f 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -4446,6 +4446,8 @@ subroutine aeropt asy1 = f_zero sca1 = f_zero ssa1 = f_zero + asy = f_zero + ssa = f_zero do m = 1, kcm1 cm = max(aerms(k,m),0.0) * dz1(k) ext1 = ext1 + cm*extrhi_grt(m,ib) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 1b71e011e..f2a21c683 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -161,7 +161,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & jmin(im), lmin(im), kbmax(im), & kbm(im), kmax(im) ! -! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), + real(kind=kind_phys) acrt(im), acrtfct(im) real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), @@ -247,18 +247,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & qrcko(im,km), qrcdo(im,km), & pwo(im,km), pwdo(im,km), c0t(im,km), & tx1(im), sumx(im), cnvwt(im,km) -! &, rhbar(im) + &, rhbar(im) ! logical do_aerosols, totflg, cnvflg(im), asqecflg(im), flg(im) ! ! asqecflg: flag for the quasi-equilibrium assumption of Arakawa-Schubert ! -! real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) -!! save pcrit, acritt -! data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., -! & 350.,300.,250.,200.,150./ -! data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, -! & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ + real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) + save pcrit, acritt + data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., + & 350.,300.,250.,200.,150./ + data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, + & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ c gdas derived acrit c data acritt/.203,.515,.521,.566,.625,.665,.659,.688, c & .743,.813,.886,.947,1.138,1.377,1.896/ @@ -318,8 +318,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & edt(i) = 0. edto(i) = 0. edtx(i) = 0. -! acrt(i) = 0. -! acrtfct(i) = 1. + acrt(i) = 0. + acrtfct(i) = 1. aa1(i) = 0. aa2(i) = 0. xaa0(i) = 0. @@ -395,9 +395,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo endif c -! do k = 1, 15 -! acrit(k) = acritt(k) * (975. - pcrit(k)) -! enddo + do k = 1, 15 + acrit(k) = acritt(k) * (975. - pcrit(k)) + enddo ! dt2 = delt ! val = 1200. @@ -1246,7 +1246,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! aa1(i) = 0. qcko(i,kb(i)) = qo(i,kb(i)) qrcko(i,kb(i)) = qo(i,kb(i)) -! rhbar(i) = 0. + rhbar(i) = 0. endif enddo !> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). @@ -1268,7 +1268,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & cj dq = eta(i,k) * (qcko(i,k) - qrch) c -! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) + rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) c c check if there is excess moisture to release latent heat c @@ -1311,12 +1311,12 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo c -! do i = 1, im -! if(cnvflg(i)) then -! indx = ktcon(i) - kb(i) - 1 -! rhbar(i) = rhbar(i) / float(indx) -! endif -! enddo + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) - kb(i) - 1 + rhbar(i) = rhbar(i) / float(indx) + endif + enddo c c calculate cloud work function c @@ -2319,56 +2319,56 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c c calculate critical cloud work function c -! do i = 1, im -! if(cnvflg(i)) then -! if(pfld(i,ktcon(i)) < pcrit(15))then -! acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) -! & /(975.-pcrit(15)) -! else if(pfld(i,ktcon(i)) > pcrit(1))then -! acrt(i)=acrit(1) -! else -! k = int((850. - pfld(i,ktcon(i)))/50.) + 2 -! k = min(k,15) -! k = max(k,2) -! acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* -! & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) -! endif -! endif -! enddo -! do i = 1, im -! if(cnvflg(i)) then -! if(islimsk(i) == 1) then -! w1 = w1l -! w2 = w2l -! w3 = w3l -! w4 = w4l -! else -! w1 = w1s -! w2 = w2s -! w3 = w3s -! w4 = w4s -! endif + do i = 1, im + if(cnvflg(i)) then + if(pfld(i,ktcon(i)) < pcrit(15))then + acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) + & /(975.-pcrit(15)) + else if(pfld(i,ktcon(i)) > pcrit(1))then + acrt(i)=acrit(1) + else + k = int((850. - pfld(i,ktcon(i)))/50.) + 2 + k = min(k,15) + k = max(k,2) + acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* + & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) + endif + endif + enddo + do i = 1, im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif c c modify critical cloud workfunction by cloud base vertical velocity c -! if(pdot(i) <= w4) then -! acrtfct(i) = (pdot(i) - w4) / (w3 - w4) -! elseif(pdot(i) >= -w4) then -! acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) -! else -! acrtfct(i) = 0. -! endif -! val1 = -1. -! acrtfct(i) = max(acrtfct(i),val1) -! val2 = 1. -! acrtfct(i) = min(acrtfct(i),val2) -! acrtfct(i) = 1. - acrtfct(i) -c -c modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent + if(pdot(i) <= w4) then + acrtfct(i) = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i) >= -w4) then + acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) + else + acrtfct(i) = 0. + endif + val1 = -1. + acrtfct(i) = max(acrtfct(i),val1) + val2 = 1. + acrtfct(i) = min(acrtfct(i),val2) + acrtfct(i) = 1. - acrtfct(i) c -c if(rhbar(i) >= .8) then -c acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. -c endif +c modify acrtfct(i) by colume mean rh if nhbar(i) is greater than 80 percent + + if(rhbar(i) >= .8) then + acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. + endif c c modify adjustment time scale by cloud base vertical velocity c @@ -2380,8 +2380,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! dtconv(i) = max(dtconv(i),dtmin) ! dtconv(i) = min(dtconv(i),dtmax) c -! endif -! enddo + endif + enddo ! ! compute convective turn-over time ! diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index ab67f849e..081bbf48e 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -287,11 +287,11 @@ subroutine sfc_sice_run & q0 = min(qs1, q0) if (fice(i) < cimin) then - print *,'warning: ice fraction is low:', fice(i) +! print *,'warning: ice fraction is low:', fice(i) fice(i) = cimin tice(i) = tgice tskin(i)= tgice - print *,'fix ice fraction: reset it to:', fice(i) +! print *,'fix ice fraction: reset it to:', fice(i) endif ffw(i) = one - fice(i) @@ -362,9 +362,9 @@ subroutine sfc_sice_run & snowd(i) = min( snowd(i), hsmax ) if (snowd(i) > (2.0_kind_phys*hice(i))) then - print *, 'warning: too much snow :',snowd(i) +! print *, 'warning: too much snow :',snowd(i) snowd(i) = hice(i) + hice(i) - print *,'fix: decrease snow depth to:',snowd(i) +! print *,'fix: decrease snow depth to:',snowd(i) endif endif enddo From 79ae254afab6f9d1dd22004fed1f6123480ebfff Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 2 Feb 2021 13:52:19 -0600 Subject: [PATCH 2/5] update merra2 before a new pull request --- physics/GFS_phys_time_vary.fv3.F90 | 23 +++-- physics/aerclm_def.F | 4 +- physics/aerinterp.F90 | 100 ++++++++++----------- physics/radiation_aerosols.f | 2 +- physics/samfdeepcnv.f | 138 ++++++++++++++--------------- 5 files changed, 138 insertions(+), 129 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 3c894b777..9354603cf 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -18,7 +18,7 @@ module GFS_phys_time_vary use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm - use aerinterp, only : read_aerdata, setindxaer, aerinterpol + use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol @@ -59,14 +59,17 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! Local variables integer :: nb, nblks, nt - integer :: i, j, ix + integer :: i, j, ix, iamin, iamax, jamin, jamax logical :: non_uniform_blocks ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (is_initialized) return - + iamin=999 + iamax=-999 + jamin=999 + jamax=-999 nblks = size(Model%blksz) ! Non-uniform blocks require special handling: instead @@ -100,6 +103,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & +!$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (ntrcaer,nblks,nthrds,non_uniform_blocks) #ifdef OPENMP @@ -230,14 +234,22 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !> - Call setindxaer() to initialize aerosols data if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) +!$OMP single +!!!!$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & Data(nb)%Grid%jindx2_aer, Data(nb)%Grid%ddy_aer, Data(nb)%Grid%xlon_d, & Data(nb)%Grid%iindx1_aer, Data(nb)%Grid%iindx2_aer, Data(nb)%Grid%ddx_aer, & Model%me, Model%master) + iamin=min(minval(Data(nb)%Grid%iindx1_aer), iamin) + iamax=max(maxval(Data(nb)%Grid%iindx2_aer), iamax) + jamin=min(minval(Data(nb)%Grid%jindx1_aer), jamin) + jamax=max(maxval(Data(nb)%Grid%jindx2_aer), jamax) enddo -!$OMP end do +!!!!$OMP end do + call read_aerdataf (iamin, iamax, jamin, jamax, Model%me,Model%master,Model%iflip, & + Model%idate,errmsg,errflg) +!$OMP end single endif !> - Call setindxci() to initialize IN and CCN data @@ -497,7 +509,6 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, enddo endif endif - #if 0 !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) if (first_time_step) then diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F index 84852a1de..426881fe4 100644 --- a/physics/aerclm_def.F +++ b/physics/aerclm_def.F @@ -2,8 +2,8 @@ module aerclm_def use machine , only : kind_phys implicit none - integer, parameter :: levsaer=50, ntrcaerm=15, timeaer=12 - integer :: latsaer, lonsaer, ntrcaer + integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer, levsw character*10 :: specname(ntrcaerm) real (kind=kind_phys):: aer_time(13) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index e7cd6ca20..8686bfa78 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -11,7 +11,7 @@ module aerinterp private - public :: read_aerdata, setindxaer, aerinterpol + public :: read_aerdata, setindxaer, aerinterpol, read_aerdataf contains @@ -32,11 +32,6 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) logical :: file_exist integer, allocatable :: invardims(:) - real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff - real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx - real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp - real(kind=kind_io8),allocatable,dimension(:) :: aer_lati - real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! !! =================================================================== if (me == master) then @@ -72,50 +67,62 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) ! specify latsaer, lonsaer, hmx lonsaer = dim1 latsaer = dim2 - hmx = int(dim1/2) ! to swap long from W-E to E-W + levsw = dim3 if(me==master) then print *, 'MERRA2 dim: ',dim1, dim2, dim3 endif ! allocate arrays - if (.not. allocated(aer_loni)) then - allocate (aer_loni(lonsaer)) - allocate (aer_lati(latsaer)) - endif if (.not. allocated(aer_lat)) then allocate(aer_lat(latsaer)) allocate(aer_lon(lonsaer)) - allocate(aerin(lonsaer,latsaer,levsaer,ntrcaerm,timeaer)) - allocate(aer_pres(lonsaer,latsaer,levsaer,timeaer)) endif ! construct lat/lon array call nf_inq_varid(ncid, 'lat', varid) - call nf_get_var(ncid, varid, aer_lati) + call nf_get_var(ncid, varid, aer_lat) call nf_inq_varid(ncid, 'lon', varid) - call nf_get_var(ncid, varid, aer_loni) - - do i = 1, hmx ! flip from (-180,180) to (0,360) - if(aer_loni(i)<0.) aer_loni(i)=aer_loni(i)+360. - aer_lon(i+hmx) = aer_loni(i) - aer_lon(i) = aer_loni(i+hmx) - enddo + call nf_get_var(ncid, varid, aer_lon) + call nf_close(ncid) + END SUBROUTINE read_aerdata +! +!********************************************************************** + SUBROUTINE read_aerdataf (iamin, iamax, jamin, jamax, & + me, master, iflip, idate, errmsg, errflg) + use machine, only: kind_phys, kind_io4, kind_io8 + use aerclm_def + use netcdf - do i = 1, latsaer - aer_lat(i) = aer_lati(i) - enddo +!--- in/out + integer, intent(in) :: me, master, iflip, idate(4) + integer, intent(in) :: iamin, iamax, jamin, jamax + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg - call nf_close(ncid) +!--- locals + integer :: ncid, varid + integer :: i, j, k, n, ii, imon, klev + character :: fname*50, mn*2, vname*10 + logical :: file_exist + integer, allocatable :: invardims(:) + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp +! + if (.not. allocated(aerin)) then + allocate(aerin(iamin:iamax,jamin:jamax,levsaer,ntrcaerm,timeaer)) + allocate(aer_pres(iamin:iamax,jamin:jamax,levsaer,timeaer)) + endif ! allocate local working arrays if (.not. allocated(buff)) then - allocate (buff(lonsaer, latsaer, dim3)) - allocate (pres_tmp(lonsaer,dim3)) + allocate (buff(lonsaer, latsaer, levsw)) + allocate (pres_tmp(lonsaer,levsw)) endif if (.not. allocated(buffx)) then - allocate (buffx(lonsaer, latsaer, dim3,1)) + allocate (buffx(lonsaer, latsaer, levsw,1)) endif !! =================================================================== @@ -137,11 +144,11 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_inq_varid(ncid, "DELP", varid) call nf_get_var(ncid, varid, buff) - do j = 1, latsaer - do i = 1, lonsaer + do j = jamin, jamax + do i = iamin, iamax ! constract pres_tmp (top-down), note input is top-down pres_tmp(i,1) = 0. - do k=2, dim3 + do k=2, levsw pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) enddo !k-loop enddo !i-loop (lon) @@ -151,11 +158,10 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( dim3 - k ) + 1 + klev = ( levsw - k ) + 1 endif - do i = 1, hmx - aer_pres(i+hmx,j,k,imon)= 1.d0*pres_tmp(i,klev) - aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i+hmx,klev) + do i = iamin, iamax + aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i,klev) enddo !i-loop (lon) enddo !k-loop (lev) enddo !j-loop (lat) @@ -168,22 +174,18 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_inq_varid(ncid, vname, varid) call nf_get_var(ncid, varid, buffx) - do j = 1, latsaer + do j = jamin, jamax do k = 1, levsaer ! input is from toa to sfc if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( dim3 - k ) + 1 + klev = ( levsw - k ) + 1 endif - do i = 1, hmx - aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) - if(aerin(i+hmx,j,k,ii,imon)<0.or.aerin(i+hmx,j,k,ii,imon)>1.) then - aerin(i+hmx,j,k,ii,imon) = 0. - end if - aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + do i = iamin, iamax + aerin(i,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) if(aerin(i,j,k,ii,imon)<0.or.aerin(i,j,k,ii,imon)>1.) then - aerin(i,j,k,ii,imon) = 0. + aerin(i,j,k,ii,imon) = 1.e-15 end if enddo !i-loop (lon) enddo !k-loop (lev) @@ -195,13 +197,9 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_close(ncid) enddo !imon-loop !--- - deallocate (aer_loni, aer_lati) deallocate (buff, pres_tmp) deallocate (buffx) - - END SUBROUTINE read_aerdata -! -!********************************************************************** + END SUBROUTINE read_aerdataf ! SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & iindx1,iindx2,ddx,me,master) @@ -341,7 +339,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) - + ENDDO ENDDO @@ -369,7 +367,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & tx1 = temi/(aerpres(j,i1) - aerpres(j,i2)) tx2 = temj/(aerpres(j,i1) - aerpres(j,i2)) DO ii = 1, ntrcaer - aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 + aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO endif ENDDO !L-loop diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 130c6471f..e1e66b0d9 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -561,7 +561,7 @@ subroutine aer_init & laswflg= (mod(iaerflg,10) > 0) ! control flag for sw tropospheric aerosol lalwflg= (mod(iaerflg/10,10) > 0) ! control flag for lw tropospheric aerosol - lavoflg= (iaerflg >= 100) ! control flag for stratospheric volcanic aeros + lavoflg= (mod(iaerflg/100,10) >0) ! control flag for stratospheric volcanic aeros !> -# Call wrt_aerlog() to write aerosol parameter configuration to output logs. diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index f2a21c683..1b71e011e 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -161,7 +161,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & jmin(im), lmin(im), kbmax(im), & kbm(im), kmax(im) ! - real(kind=kind_phys) acrt(im), acrtfct(im) +! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), @@ -247,18 +247,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & qrcko(im,km), qrcdo(im,km), & pwo(im,km), pwdo(im,km), c0t(im,km), & tx1(im), sumx(im), cnvwt(im,km) - &, rhbar(im) +! &, rhbar(im) ! logical do_aerosols, totflg, cnvflg(im), asqecflg(im), flg(im) ! ! asqecflg: flag for the quasi-equilibrium assumption of Arakawa-Schubert ! - real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) - save pcrit, acritt - data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., - & 350.,300.,250.,200.,150./ - data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, - & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ +! real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) +!! save pcrit, acritt +! data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., +! & 350.,300.,250.,200.,150./ +! data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, +! & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ c gdas derived acrit c data acritt/.203,.515,.521,.566,.625,.665,.659,.688, c & .743,.813,.886,.947,1.138,1.377,1.896/ @@ -318,8 +318,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & edt(i) = 0. edto(i) = 0. edtx(i) = 0. - acrt(i) = 0. - acrtfct(i) = 1. +! acrt(i) = 0. +! acrtfct(i) = 1. aa1(i) = 0. aa2(i) = 0. xaa0(i) = 0. @@ -395,9 +395,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo endif c - do k = 1, 15 - acrit(k) = acritt(k) * (975. - pcrit(k)) - enddo +! do k = 1, 15 +! acrit(k) = acritt(k) * (975. - pcrit(k)) +! enddo ! dt2 = delt ! val = 1200. @@ -1246,7 +1246,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! aa1(i) = 0. qcko(i,kb(i)) = qo(i,kb(i)) qrcko(i,kb(i)) = qo(i,kb(i)) - rhbar(i) = 0. +! rhbar(i) = 0. endif enddo !> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). @@ -1268,7 +1268,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & cj dq = eta(i,k) * (qcko(i,k) - qrch) c - rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) c c check if there is excess moisture to release latent heat c @@ -1311,12 +1311,12 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo c - do i = 1, im - if(cnvflg(i)) then - indx = ktcon(i) - kb(i) - 1 - rhbar(i) = rhbar(i) / float(indx) - endif - enddo +! do i = 1, im +! if(cnvflg(i)) then +! indx = ktcon(i) - kb(i) - 1 +! rhbar(i) = rhbar(i) / float(indx) +! endif +! enddo c c calculate cloud work function c @@ -2319,56 +2319,56 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c c calculate critical cloud work function c - do i = 1, im - if(cnvflg(i)) then - if(pfld(i,ktcon(i)) < pcrit(15))then - acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) - & /(975.-pcrit(15)) - else if(pfld(i,ktcon(i)) > pcrit(1))then - acrt(i)=acrit(1) - else - k = int((850. - pfld(i,ktcon(i)))/50.) + 2 - k = min(k,15) - k = max(k,2) - acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* - & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) - endif - endif - enddo - do i = 1, im - if(cnvflg(i)) then - if(islimsk(i) == 1) then - w1 = w1l - w2 = w2l - w3 = w3l - w4 = w4l - else - w1 = w1s - w2 = w2s - w3 = w3s - w4 = w4s - endif +! do i = 1, im +! if(cnvflg(i)) then +! if(pfld(i,ktcon(i)) < pcrit(15))then +! acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) +! & /(975.-pcrit(15)) +! else if(pfld(i,ktcon(i)) > pcrit(1))then +! acrt(i)=acrit(1) +! else +! k = int((850. - pfld(i,ktcon(i)))/50.) + 2 +! k = min(k,15) +! k = max(k,2) +! acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* +! & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) +! endif +! endif +! enddo +! do i = 1, im +! if(cnvflg(i)) then +! if(islimsk(i) == 1) then +! w1 = w1l +! w2 = w2l +! w3 = w3l +! w4 = w4l +! else +! w1 = w1s +! w2 = w2s +! w3 = w3s +! w4 = w4s +! endif c c modify critical cloud workfunction by cloud base vertical velocity c - if(pdot(i) <= w4) then - acrtfct(i) = (pdot(i) - w4) / (w3 - w4) - elseif(pdot(i) >= -w4) then - acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) - else - acrtfct(i) = 0. - endif - val1 = -1. - acrtfct(i) = max(acrtfct(i),val1) - val2 = 1. - acrtfct(i) = min(acrtfct(i),val2) - acrtfct(i) = 1. - acrtfct(i) +! if(pdot(i) <= w4) then +! acrtfct(i) = (pdot(i) - w4) / (w3 - w4) +! elseif(pdot(i) >= -w4) then +! acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) +! else +! acrtfct(i) = 0. +! endif +! val1 = -1. +! acrtfct(i) = max(acrtfct(i),val1) +! val2 = 1. +! acrtfct(i) = min(acrtfct(i),val2) +! acrtfct(i) = 1. - acrtfct(i) c -c modify acrtfct(i) by colume mean rh if nhbar(i) is greater than 80 percent - - if(rhbar(i) >= .8) then - acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. - endif +c modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent +c +c if(rhbar(i) >= .8) then +c acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. +c endif c c modify adjustment time scale by cloud base vertical velocity c @@ -2380,8 +2380,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! dtconv(i) = max(dtconv(i),dtmin) ! dtconv(i) = min(dtconv(i),dtmax) c - endif - enddo +! endif +! enddo ! ! compute convective turn-over time ! From b55e3827beb90625839ef323891f9cd7db1e741d Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 9 Mar 2021 10:16:49 -0600 Subject: [PATCH 3/5] resolved the conflicts in GFS_phys_time_vary.fv3.F90 --- physics/GFS_phys_time_vary.fv3.F90 | 301 +++-------------------------- physics/rte-rrtmgp | 2 +- 2 files changed, 26 insertions(+), 277 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 801c73ad9..57d253083 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -166,9 +166,7 @@ subroutine GFS_phys_time_vary_init ( integer, intent(out) :: errflg ! Local variables - integer :: nb, nblks, nt - integer :: i, j, ix, iamin, iamax, jamin, jamax, vegtyp - logical :: non_uniform_blocks + integer :: i, j, ix, vegtyp, iamin, iamax, jamin, jamax real(kind_phys) :: rsnow !--- Noah MP @@ -188,43 +186,13 @@ subroutine GFS_phys_time_vary_init ( iamax=-999 jamin=999 jamax=-999 - nblks = size(Model%blksz) - - ! Non-uniform blocks require special handling: instead - ! of nthrds elements of the Interstitial array, there are - ! nthrds+1 elements. The extra Interstitial(nthrds+1) is - ! allocated for the smaller block length of the last block, - ! while all other elements are allocated to the maximum - ! block length (which is the same for all blocks except - ! the last block). - if (minval(Model%blksz)==maxval(Model%blksz)) then - non_uniform_blocks = .false. - else - non_uniform_blocks = .true. - end if - - ! Consistency check - number of threads passed in via the argument list - ! has to match the size of the Interstitial data type. - if (.not. non_uniform_blocks .and. nthrds/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds does not match size of Interstitial variable' - errflg = 1 - return - else if (non_uniform_blocks .and. nthrds+1/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds+1 does not match size of Interstitial variable ' // & - '(including extra last element for shorter blocksizes)' - errflg = 1 - return - end if -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb) & +!$OMP parallel num_threads(nthrds) default(none) & !$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,idate) & -!$OMP shared (Model,Data,Interstitial,errmsg,errflg) & -!$OMP shared (xlat_d,xlon_d,imap,jmap) & +!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & -!$OMP shared (iamin, iamax, jamin, jamax) & -!$OMP shared (nblks,nthrds,non_uniform_blocks) +!$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (iaerclm,ntrcaer,aer_nm,iflip,iccn) & !$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & @@ -233,16 +201,10 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & !$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & !$OMP private (ix,i,j,rsnow,vegtyp) -!$OMP sections - -#ifdef OPENMP - nt = omp_get_thread_num()+1 -#else - nt = 1 -#endif -======= +!$OMP sections +!$OMP section !> - Call read_o3data() to read ozone data call read_o3data (ntoz, me, master) @@ -343,28 +305,20 @@ subroutine GFS_phys_time_vary_init ( call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif -!$OMP section !> - Call setindxaer() to initialize aerosols data - if (Model%iaerclm) then -!$OMP single -!!!!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & - Data(nb)%Grid%jindx2_aer, Data(nb)%Grid%ddy_aer, Data(nb)%Grid%xlon_d, & - Data(nb)%Grid%iindx1_aer, Data(nb)%Grid%iindx2_aer, Data(nb)%Grid%ddx_aer, & - Model%me, Model%master) - iamin=min(minval(Data(nb)%Grid%iindx1_aer), iamin) - iamax=max(maxval(Data(nb)%Grid%iindx2_aer), iamax) - jamin=min(minval(Data(nb)%Grid%jindx1_aer), jamin) - jamax=max(maxval(Data(nb)%Grid%jindx2_aer), jamax) - enddo -!!!!$OMP end do - call read_aerdataf (iamin, iamax, jamin, jamax, Model%me,Model%master,Model%iflip, & - Model%idate,errmsg,errflg) -!$OMP end single +!$OMP section + if (iaerclm) then + call setindxaer (im, xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer, & + me, master) + iamin=min(minval(iindx1_aer), iamin) + iamax=max(maxval(iindx2_aer), iamax) + jamin=min(minval(jindx1_aer), jamin) + jamax=max(maxval(jindx2_aer), jamax) endif - !$OMP section + !> - Call setindxci() to initialize IN and CCN data if (iccn == 1) then call setindxci (im, xlat_d, jindx1_ci, & @@ -422,6 +376,10 @@ subroutine GFS_phys_time_vary_init ( !$OMP end sections !$OMP end parallel + if (iaerclm) then + call read_aerdataf (iamin, iamax, jamin, jamax, me,master,iflip, & + idate,errmsg,errflg) + endif if (lsm == lsm_noahmp) then if (all(tvxy < zero)) then @@ -859,10 +817,10 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - Call ciinterpol() to make IN and CCN data interpolation if (iccn == 1) then - call ciinterpol (me, im, idate, fhour, & - jindx1_ci, jindx2_ci, & - ddy_ci, iindx1_ci, & - iindx2_ci, ddx_ci, & + call ciinterpol (me, im, idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & levs, prsl, in_nm, ccn_nm) endif @@ -957,214 +915,5 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) end subroutine GFS_phys_time_vary_finalize - -!> \section arg_table_GFS_phys_time_vary_run Argument Table -!! \htmlinclude GFS_phys_time_vary_run.html -!! -!>\section gen_GFS_phys_time_vary_run GFS_phys_time_vary_run General Algorithm -!> @{ - subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, errflg) - - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_data_type - - implicit none - - ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - type(GFS_control_type), intent(inout) :: Model - integer, intent(in) :: nthrds - logical, intent(in) :: first_time_step - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - - integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad, vegtyp - real(kind=kind_phys) :: sec_zero, rsnow - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Check initialization status - if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_run called before GFS_phys_time_vary_init" - errflg = 1 - return - end if - - nblks = size(Model%blksz) - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nb,iskip,ix,i,j,k) & -!$OMP shared (Model,Data,iseed,wrk,rannie,rndval) & -!$OMP shared (nblks) - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - ! Model%imfdeepcnv < 0 when Model%ras = .true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then -!$OMP single - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)*1000.0) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo -!$OMP end single - - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny -!$OMP do schedule (dynamic,1) - do nb=1,nblks - do ix=1,Model%blksz(nb) - j = Data(nb)%Tbd%jmap(ix) - i = Data(nb)%Tbd%imap(ix) - Data(nb)%Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo -!$OMP end do - enddo - endif ! imfdeepcnv, cal_re, random_clds - -!> - Call ozinterpol() to make ozone interpolation - if (Model%ntoz > 0) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_o3, Data(nb)%Grid%jindx2_o3, & - Data(nb)%Tbd%ozpl, Data(nb)%Grid%ddy_o3) - enddo -!$OMP end do - endif - -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation - if (Model%h2o_phys) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_h, Data(nb)%Grid%jindx2_h, & - Data(nb)%Tbd%h2opl, Data(nb)%Grid%ddy_h) - enddo -!$OMP end do - endif - -!> - Call aerinterpol() to make aerosol interpolation - if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_aer, Data(nb)%Grid%jindx2_aer, & - Data(nb)%Grid%ddy_aer,Data(nb)%Grid%iindx1_aer, & - Data(nb)%Grid%iindx2_aer,Data(nb)%Grid%ddx_aer, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%aer_nm) - enddo -!$OMP end do - endif - -!> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn == 1) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_ci, Data(nb)%Grid%jindx2_ci, & - Data(nb)%Grid%ddy_ci,Data(nb)%Grid%iindx1_ci, & - Data(nb)%Grid%iindx2_ci,Data(nb)%Grid%ddx_ci, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%in_nm, Data(nb)%Tbd%ccn_nm) - enddo -!$OMP end do - endif - -!$OMP end parallel - -!> - 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, nthrds, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) - endif - endif - - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - else - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - endif -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do nb = 1, nblks - do ix = 1, Model%blksz(nb) - Data(nb)%Sfcprop%sncovr(ix) = 0.0 - if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Data(nb)%Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - enddo - endif - endif -#endif - - end subroutine GFS_phys_time_vary_run -!> @} - end module GFS_phys_time_vary !> @} diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 7adf202c82d14ebecb1078bb17be85fc4abfeee8 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 16 Mar 2021 08:42:17 -0500 Subject: [PATCH 4/5] remove a space in aerinterp.F90 and aerclm_def.f --- physics/aerclm_def.F | 23 ----------------------- physics/aerinterp.F90 | 1 - 2 files changed, 24 deletions(-) delete mode 100644 physics/aerclm_def.F diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F deleted file mode 100644 index 426881fe4..000000000 --- a/physics/aerclm_def.F +++ /dev/null @@ -1,23 +0,0 @@ - module aerclm_def - use machine , only : kind_phys - implicit none - - integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 - integer :: latsaer, lonsaer, ntrcaer, levsw - - character*10 :: specname(ntrcaerm) - real (kind=kind_phys):: aer_time(13) - - real (kind=kind_phys), allocatable, dimension(:) :: aer_lat - real (kind=kind_phys), allocatable, dimension(:) :: aer_lon - real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres - real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin - - data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, - & 227.5, 258., 288.5, 319., 349.5, 380.5/ - - data specname /'DU001','DU002','DU003','DU004','DU005', - & 'SS001','SS002','SS003','SS004','SS005','SO4', - & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ - - end module aerclm_def diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 8686bfa78..bed73c5be 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -339,7 +339,6 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) - ENDDO ENDDO From f34b1b0292b75a39a7452d1536f7d8646c6ed782 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 16 Mar 2021 08:50:51 -0500 Subject: [PATCH 5/5] remove aerclm_def.F in IPD and add it in CCPP --- physics/aerclm_def.F | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 physics/aerclm_def.F diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F new file mode 100644 index 000000000..426881fe4 --- /dev/null +++ b/physics/aerclm_def.F @@ -0,0 +1,23 @@ + module aerclm_def + use machine , only : kind_phys + implicit none + + integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer, levsw + + character*10 :: specname(ntrcaerm) + real (kind=kind_phys):: aer_time(13) + + real (kind=kind_phys), allocatable, dimension(:) :: aer_lat + real (kind=kind_phys), allocatable, dimension(:) :: aer_lon + real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres + real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin + + data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, + & 227.5, 258., 288.5, 319., 349.5, 380.5/ + + data specname /'DU001','DU002','DU003','DU004','DU005', + & 'SS001','SS002','SS003','SS004','SS005','SO4', + & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ + + end module aerclm_def