Skip to content

Commit

Permalink
Merge remote-tracking branch 'origin/develop' into dump_cpl_fields
Browse files Browse the repository at this point in the history
  • Loading branch information
DusanJovic-NOAA committed Jul 3, 2024
2 parents 0753ad0 + 10cd023 commit b2288be
Show file tree
Hide file tree
Showing 16 changed files with 436 additions and 256 deletions.
2 changes: 1 addition & 1 deletion atmos_cubed_sphere
72 changes: 60 additions & 12 deletions atmos_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -533,12 +533,12 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
type (time_type), intent(in) :: Time_init, Time, Time_step
!--- local variables ---
integer :: unit, i
integer :: mlon, mlat, nlon, nlat, nlev, sec
integer :: mlon, mlat, nlon, nlat, nlev, sec, sec_lastfhzerofh
integer :: ierr, io, logunit
integer :: tile_num
integer :: isc, iec, jsc, jec
real(kind=GFS_kind_phys) :: dt_phys
logical :: p_hydro, hydro
logical :: p_hydro, hydro, tmpflag_fhzero
logical, save :: block_message = .true.
type(GFS_init_type) :: Init_parm
integer :: bdat(8), cdat(8)
Expand Down Expand Up @@ -789,8 +789,33 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
!--- WARNING: For special cases that model needs to restart at non-multiple of fhzero
!--- the fields in first output files are not accumulated from the beginning of
!--- the bucket, but the restart time.
if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then
diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0)
if( GFS_Control%fhzero_array(1) > 0. ) then
fhzero_loop: do i=1,size(GFS_Control%fhzero_array)
tmpflag_fhzero= .false.
if( GFS_Control%fhzero_array(i) > 0.) then
if( i == 1 ) then
if( sec <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true.
else if( i > 1 ) then
if( sec > GFS_Control%fhzero_fhour(i-1)*3600. .and. sec <=GFS_Control%fhzero_fhour(i)*3600. ) &
tmpflag_fhzero = .true.
endif
if( tmpflag_fhzero ) then
GFS_Control%fhzero = GFS_Control%fhzero_array(i)
if( GFS_Control%fhzero > 0) then
sec_lastfhzerofh = (int(sec/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600
else
sec_lastfhzerofh = 0
endif
endif
endif
enddo fhzero_loop
else
sec_lastfhzerofh = 0
endif
if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600.,sec_lastfhzerofh/3600

if (mod((sec-sec_lastfhzerofh),int(GFS_Control%fhzero*3600.)) /= 0) then
diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys-sec_lastfhzerofh),int(GFS_Control%fhzero))*3600.0)
if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero'
endif
if (Atmos%iau_offset > zero) then
Expand Down Expand Up @@ -949,8 +974,9 @@ subroutine update_atmos_model_state (Atmos, rc)
type (atmos_data_type), intent(inout) :: Atmos
integer, optional, intent(out) :: rc
!--- local variables
integer :: localrc
integer :: i, localrc, sec_lastfhzerofh
integer :: isec, seconds, isec_fhzero
logical :: tmpflag_fhzero
real(kind=GFS_kind_phys) :: time_int, time_intfull
!
if (present(rc)) rc = ESMF_SUCCESS
Expand Down Expand Up @@ -1001,16 +1027,38 @@ subroutine update_atmos_model_state (Atmos, rc)
GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, &
GFS_control%fhswr, GFS_control%fhlwr)
endif
if (nint(GFS_control%fhzero) > 0) then
if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time

!--- find current fhzero
if( GFS_Control%fhzero_array(1) > 0. ) then
fhzero_loop: do i=1,size(GFS_Control%fhzero_array)
tmpflag_fhzero = .false.
if( GFS_Control%fhzero_array(i) > 0.) then
if( i == 1 ) then
if( seconds <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true.
else if( i > 1 ) then
if( seconds > GFS_Control%fhzero_fhour(i-1)*3600. .and. seconds <= GFS_Control%fhzero_fhour(i)*3600. ) &
tmpflag_fhzero = .true.
endif
if( tmpflag_fhzero) then
GFS_Control%fhzero = GFS_Control%fhzero_array(i)
if( GFS_Control%fhzero > 0) then
sec_lastfhzerofh = (int(seconds/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600
else
sec_lastfhzerofh = 0
endif
endif
endif
enddo fhzero_loop
else
if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time
sec_lastfhzerofh = 0
endif
call diag_send_complete_instant (Atmos%Time)
if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update, fhzero=',GFS_Control%fhzero, 'fhour=',seconds/3600.,sec_lastfhzerofh/3600.


!--- this may not be necessary once write_component is fully implemented
!!!call diag_send_complete_extra (Atmos%Time)
if (nint(GFS_Control%fhzero) > 0) then
if (mod(isec - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time
! if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update time=',isec/3600.,'last fhzeo=',sec_lastfhzerofh
endif
call diag_send_complete_instant (Atmos%Time)

!--- get bottom layer data from dynamical core for coupling
call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data)
Expand Down
30 changes: 30 additions & 0 deletions ccpp/data/CCPP_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -452,10 +452,18 @@ module CCPP_typedefs
integer :: ie
integer :: isd
integer :: ied
integer :: isc1
integer :: iec1
integer :: isc2
integer :: iec2
integer :: js
integer :: je
integer :: jsd
integer :: jed
integer :: jsc1
integer :: jec1
integer :: jsc2
integer :: jec2
integer :: ng
integer :: npz
integer :: npzp1
Expand Down Expand Up @@ -1557,6 +1565,18 @@ subroutine gfdl_interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd
integer, intent(in) :: mpirank
integer, intent(in) :: mpiroot
!
integer :: isc1, jsc1, iec1, jec1
integer :: isc2, jsc2, iec2, jec2
!
isc1 = lbound(delp, dim=1)
jsc1 = lbound(delp, dim=2)
iec1 = ubound(delp, dim=1)
jec1 = ubound(delp, dim=2)
isc2 = lbound(delz, dim=1)
jsc2 = lbound(delz, dim=2)
iec2 = ubound(delz, dim=1)
jec2 = ubound(delz, dim=2)
!
#ifdef MOIST_CAPPA
Interstitial%npzcappa = npz
allocate (Interstitial%cappa (isd:ied, jsd:jed, 1:npz) )
Expand Down Expand Up @@ -1594,13 +1614,22 @@ subroutine gfdl_interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd
Interstitial%ie = ie
Interstitial%isd = isd
Interstitial%ied = ied
Interstitial%isc1 = isc1
Interstitial%iec1 = iec1
Interstitial%isc2 = isc2
Interstitial%iec2 = iec2
Interstitial%js = js
Interstitial%je = je
Interstitial%jsd = jsd
Interstitial%jed = jed
Interstitial%jsc1 = jsc1
Interstitial%jec1 = jec1
Interstitial%jsc2 = jsc2
Interstitial%jec2 = jec2
Interstitial%ng = ng
Interstitial%npz = npz
Interstitial%npzp1 = npz+1
!
! Set up links from GFDL_interstitial DDT to ATM DDT
Interstitial%delp => delp
Interstitial%delz => delz
Expand All @@ -1617,6 +1646,7 @@ subroutine gfdl_interstitial_create (Interstitial, is, ie, isd, ied, js, je, jsd
if (do_qs) Interstitial%qs => qs
if (do_qg) Interstitial%qg => qg
if (do_qa) Interstitial%qc => qc
!
#ifdef USE_COND
Interstitial%npzq_con = npz
#else
Expand Down
Loading

0 comments on commit b2288be

Please sign in to comment.