Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Bugfix for levr<levs, update of gcycle.F90/sfcsub.F for coupled model (Sm mar032020) #404

Closed
wants to merge 6 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 6 additions & 6 deletions physics/GFS_rrtmg_post.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
138 changes: 59 additions & 79 deletions physics/GFS_rrtmg_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
!
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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


Expand Down
4 changes: 2 additions & 2 deletions physics/GFS_rrtmg_setup.F90
Original file line number Diff line number Diff line change
Expand Up @@ -400,7 +400,7 @@ subroutine radinit( si, NLAY, imp_physics, me )
! !
! attributes: !
! language: fortran 90 !
! machine: wcoss !
! machine: wcoss !
! !
! ==================== definition of variables ==================== !
! !
Expand Down Expand Up @@ -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!
Expand Down
24 changes: 12 additions & 12 deletions physics/dcyc2.meta
Original file line number Diff line number Diff line change
Expand Up @@ -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
climbfuji marked this conversation as resolved.
Show resolved Hide resolved
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
Expand Down
8 changes: 8 additions & 0 deletions physics/gcycle.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions physics/moninedmf.meta
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading