Skip to content

Commit

Permalink
Merge pull request #100 from grantfirl/ufs-dev-PR85
Browse files Browse the repository at this point in the history
UFS-dev PR#85
  • Loading branch information
grantfirl authored Oct 3, 2023
2 parents 791ec9d + bfedea6 commit 547f94f
Show file tree
Hide file tree
Showing 5 changed files with 238 additions and 127 deletions.
52 changes: 30 additions & 22 deletions atmos_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -787,7 +787,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
!--- Model should restart at the forecast hours that are multiples of fhzero.
!--- 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.
!--- 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 (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero'
Expand Down Expand Up @@ -2840,7 +2840,7 @@ subroutine setup_exportdata(rc)
integer :: isc, iec, jsc, jec
integer :: nb, nk
integer :: sphum, liq_wat, ice_wat, o3mr
real(GFS_kind_phys) :: rtime, rtimek
real(GFS_kind_phys) :: rtime, rtimek, spval

integer :: localrc
integer :: n,rank
Expand All @@ -2853,7 +2853,8 @@ subroutine setup_exportdata(rc)

!--- local parameters
real(kind=ESMF_KIND_R8), parameter :: zeror8 = 0._ESMF_KIND_R8

real(GFS_kind_phys), parameter :: revap = one/2.501E+06_GFS_kind_phys ! reciprocal of specific
! heat of vaporization J/kg
!--- begin
if (present(rc)) rc = ESMF_SUCCESS

Expand All @@ -2865,6 +2866,7 @@ subroutine setup_exportdata(rc)

rtime = one / GFS_control%dtp
rtimek = GFS_control%rho_h2o * rtime
spval = GFS_control%huge

do n=1, size(exportFields)

Expand Down Expand Up @@ -2931,6 +2933,9 @@ subroutine setup_exportdata(rc)
! Instantaneous Latent heat flux (W/m**2)
case ('inst_laten_heat_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, rc=localrc)
! Instantaneous Evap flux (kg/m**2/s)
case ('inst_evap_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfci_cpl, Atm_block, nb, revap, spval, rc=localrc)
! Instantaneous Downward long wave radiation flux (W/m**2)
case ('inst_down_lw_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfci_cpl, Atm_block, nb, rc=localrc)
Expand Down Expand Up @@ -2988,61 +2993,64 @@ subroutine setup_exportdata(rc)
!--- Mean quantities
! MEAN Zonal compt of momentum flux (N/m**2)
case ('mean_zonal_moment_flx_atm')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dusfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN Merid compt of momentum flux (N/m**2)
case ('mean_merid_moment_flx_atm')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN Sensible heat flux (W/m**2)
case ('mean_sensi_heat_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dtsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN Latent heat flux (W/m**2)
case ('mean_laten_heat_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN Evap rate (kg/m**2/s)
case ('mean_evap_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dqsfc_cpl, Atm_block, nb, rtime*revap, rc=localrc)
! MEAN Downward LW heat flux (W/m**2)
case ('mean_down_lw_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN Downward SW heat flux (W/m**2)
case ('mean_down_sw_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET long wave radiation flux (W/m**2)
case ('mean_net_lw_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nlwsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET solar radiation flux over the ocean (W/m**2)
case ('mean_net_sw_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nswsfc_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN sfc downward nir direct flux (W/m**2)
case ('mean_down_sw_ir_dir_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN sfc downward nir diffused flux (W/m**2)
case ('mean_down_sw_ir_dif_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN sfc downward uv+vis direct flux (W/m**2)
case ('mean_down_sw_vis_dir_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN sfc downward uv+vis diffused flux (W/m**2)
case ('mean_down_sw_vis_dif_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%dvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET sfc nir direct flux (W/m**2)
case ('mean_net_sw_ir_dir_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirbm_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET sfc nir diffused flux (W/m**2)
case ('mean_net_sw_ir_dif_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nnirdf_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET sfc uv+vis direct flux (W/m**2)
case ('mean_net_sw_vis_dir_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisbm_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN NET sfc uv+vis diffused flux (W/m**2)
case ('mean_net_sw_vis_dif_flx')
call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, scale_factor=rtime, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, rc=localrc)
! MEAN precipitation rate (kg/m2/s)
case ('mean_prec_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, rtimek, spval, rc=localrc)
! MEAN convective precipitation rate (kg/m2/s)
case ('mean_prec_rate_conv')
call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, rtimek, spval, rc=localrc)
! MEAN snow precipitation rate (kg/m2/s)
case ('mean_fprec_rate')
call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc)
call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, rtimek, spval, rc=localrc)
! oceanfrac used by atm to calculate fluxes
case ('openwater_frac_in_atm')
call block_data_combine_fractions(datar82d, GFS_data(nb)%sfcprop%oceanfrac, GFS_Data(nb)%sfcprop%fice, Atm_block, nb, rc=localrc)
Expand Down
27 changes: 27 additions & 0 deletions ccpp/data/GFS_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -6821,13 +6821,21 @@ subroutine grid_create (Grid, IM, Model)
allocate (Grid%ddy_o3 (IM))
allocate (Grid%jindx1_o3 (IM))
allocate (Grid%jindx2_o3 (IM))

Grid%ddy_o3 = clear_val
Grid%jindx1_o3 = clear_val
Grid%jindx2_o3 = clear_val
endif

!--- stratosphere h2o active
if ( Model%h2o_phys ) then
allocate (Grid%ddy_h (IM))
allocate (Grid%jindx1_h (IM))
allocate (Grid%jindx2_h (IM))

Grid%ddy_h = clear_val
Grid%jindx1_h = clear_val
Grid%jindx2_h = clear_val
endif

!--- iccn active
Expand All @@ -6838,6 +6846,13 @@ subroutine grid_create (Grid, IM, Model)
allocate (Grid%ddx_ci (IM))
allocate (Grid%iindx1_ci (IM))
allocate (Grid%iindx2_ci (IM))

Grid%ddy_ci = clear_val
Grid%jindx1_ci = clear_val
Grid%jindx2_ci = clear_val
Grid%ddx_ci = clear_val
Grid%iindx1_ci = clear_val
Grid%iindx2_ci = clear_val
endif

!--- iaerclm active
Expand All @@ -6848,6 +6863,13 @@ subroutine grid_create (Grid, IM, Model)
allocate (Grid%ddx_aer (IM))
allocate (Grid%iindx1_aer(IM))
allocate (Grid%iindx2_aer(IM))

Grid%ddy_aer = clear_val
Grid%jindx1_aer = clear_val
Grid%jindx2_aer = clear_val
Grid%ddx_aer = clear_val
Grid%iindx1_aer = clear_val
Grid%iindx2_aer = clear_val
endif

!--- Model%do_ugwpv1
Expand All @@ -6856,6 +6878,11 @@ subroutine grid_create (Grid, IM, Model)
allocate (Grid%ddy_j2tau (IM))
allocate (Grid%jindx1_tau (IM))
allocate (Grid%jindx2_tau (IM))

Grid%ddy_j1tau = clear_val
Grid%ddy_j2tau = clear_val
Grid%jindx1_tau = clear_val
Grid%jindx2_tau = clear_val
endif

end subroutine grid_create
Expand Down
Loading

0 comments on commit 547f94f

Please sign in to comment.