Skip to content

Commit

Permalink
Merge branch 'ccpp_release_3_work' of https://github.com/grantfirl/cc…
Browse files Browse the repository at this point in the history
…pp-physics into grant_ccpp_release_3_work_dom_mods
  • Loading branch information
climbfuji committed May 22, 2019
2 parents a30266d + db305cc commit 4faf293
Show file tree
Hide file tree
Showing 3 changed files with 82 additions and 65 deletions.
133 changes: 74 additions & 59 deletions physics/GFS_phys_time_vary.scm.F90
Original file line number Diff line number Diff line change
Expand Up @@ -30,99 +30,114 @@ module GFS_phys_time_vary
!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------|
!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | inout | F |
!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F |
!! | Interstitial | GFS_interstitial_type_instance | Fortran DDT containing FV3-GFS interstitial data | DDT | 0 | GFS_interstitial_type | | inout | F |
!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg)
subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg)

use GFS_typedefs, only: GFS_control_type, GFS_grid_type, &
GFS_Tbd_type
GFS_Tbd_type, GFS_interstitial_type

implicit none

! Interface variables
type(GFS_grid_type), intent(inout) :: Grid
type(GFS_control_type), intent(in) :: Model
type(GFS_interstitial_type), intent(inout) :: Interstitial
type(GFS_tbd_type), intent(in) :: Tbd
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! Local variables
integer :: i, j, ix, nb
integer :: i, j, ix, nb, nt

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (is_initialized) return

nb = 1
nt = 1

if (.not. is_initialized) then
call read_o3data (Model%ntoz, Model%me, Model%master)

! Consistency check that the hardcoded values for levozp and
! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff))
if (size(Tbd%ozpl, dim=2).ne.levozp) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levozp from read_o3data does not match value in GFS_typedefs.F90: ", &
levozp, " /= ", size(Tbd%ozpl, dim=2)
errflg = 1
end if
if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", &
oz_coeff, " /= ", size(Tbd%ozpl, dim=3)
errflg = 1
end if
call read_o3data (Model%ntoz, Model%me, Model%master)

! Consistency check that the hardcoded values for levozp and
! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff))
if (size(Tbd%ozpl, dim=2).ne.levozp) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levozp from read_o3data does not match value in GFS_typedefs.F90: ", &
levozp, " /= ", size(Tbd%ozpl, dim=2)
errflg = 1
end if
if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", &
oz_coeff, " /= ", size(Tbd%ozpl, dim=3)
errflg = 1
end if

call read_h2odata (Model%h2o_phys, Model%me, Model%master)

! Consistency check that the hardcoded values for levh2o and
! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff))
if (size(Tbd%h2opl, dim=2).ne.levh2o) then
call read_h2odata (Model%h2o_phys, Model%me, Model%master)

! Consistency check that the hardcoded values for levh2o and
! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff))
if (size(Tbd%h2opl, dim=2).ne.levh2o) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", &
levh2o, " /= ", size(Tbd%h2opl, dim=2)
errflg = 1
end if
if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", &
h2o_coeff, " /= ", size(Tbd%h2opl, dim=3)
errflg = 1
end if

if (Model%aero_in) then
! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90
! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def
if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", &
levh2o, " /= ", size(Tbd%h2opl, dim=2)
errflg = 1
end if
if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", &
h2o_coeff, " /= ", size(Tbd%h2opl, dim=3)
"ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", &
ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3)
errflg = 1
end if

if (Model%aero_in) then
! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90
! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def
if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", &
ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3)
errflg = 1
else
! Update the value of ntrcaer in aerclm_def with the value defined
! in GFS_typedefs.F90 that is used to allocate the Tbd DDT.
! If Model%aero_in is .true., then ntrcaer == ntrcaerm
ntrcaer = size(Tbd%aer_nm, dim=3)
! Read aerosol climatology
call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate)
endif
else
! Update the value of ntrcaer in aerclm_def with the value defined
! in GFS_typedefs.F90 that is used to allocate the Tbd DDT.
! If Model%aero_in is .false., then ntrcaer == 1
! If Model%aero_in is .true., then ntrcaer == ntrcaerm
ntrcaer = size(Tbd%aer_nm, dim=3)
! Read aerosol climatology
call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate)
endif
if (Model%iccn) then
call read_cidata ( Model%me, Model%master)
! No consistency check needed for in/ccn data, all values are
! hardcoded in module iccn_def.F and GFS_typedefs.F90
endif
else
! Update the value of ntrcaer in aerclm_def with the value defined
! in GFS_typedefs.F90 that is used to allocate the Tbd DDT.
! If Model%aero_in is .false., then ntrcaer == 1
ntrcaer = size(Tbd%aer_nm, dim=3)
endif

if (Model%iccn) then
call read_cidata ( Model%me, Model%master)
! No consistency check needed for in/ccn data, all values are
! hardcoded in module iccn_def.F and GFS_typedefs.F90
endif

! Update values of oz_pres in Interstitial data type for all threads
if (Model%ntoz > 0) then
Interstitial%oz_pres = oz_pres
end if

! Update values of h2o_pres in Interstitial data type for all threads
if (Model%h2o_phys) then
Interstitial%h2o_pres = h2o_pres
end if


!--- read in and initialize ozone
if (Model%ntoz > 0) then
call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, &
Expand Down
12 changes: 7 additions & 5 deletions physics/micro_mg3_0.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2426,11 +2426,13 @@ subroutine micro_mg_tend ( &
if (do_cldice) then

! freezing of rain to produce ice if mean rain size is smaller than Dcs
if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then
mnuccri(i,k) = mnuccr(i,k)
nnuccri(i,k) = nnuccr(i,k)
mnuccr(i,k) = zero
nnuccr(i,k) = zero
if (lamr(i,k) > qsmall) then
if(one/lamr(i,k) < Dcs) then
mnuccri(i,k) = mnuccr(i,k)
nnuccri(i,k) = nnuccr(i,k)
mnuccr(i,k) = zero
nnuccr(i,k) = zero
end if
end if
end if

Expand Down
2 changes: 1 addition & 1 deletion physics/module_mp_thompson.F90
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ MODULE module_mp_thompson

USE module_mp_radar

#if ! defined(SION) && defined(MPI)
#if !defined(SION) && defined(MPI)
use mpi
#endif

Expand Down

0 comments on commit 4faf293

Please sign in to comment.