diff --git a/datm/CMakeLists.txt b/datm/CMakeLists.txt index d96060ab2..86098c9fc 100644 --- a/datm/CMakeLists.txt +++ b/datm/CMakeLists.txt @@ -6,6 +6,7 @@ set(SRCFILES atm_comp_nuopc.F90 datm_datamode_jra_mod.F90 datm_datamode_gefs_mod.F90 datm_datamode_cfsr_mod.F90 + datm_datamode_gfs_mod.F90 datm_datamode_era5_mod.F90) diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index ffb640454..8472b9cdf 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/datm/atm_comp_nuopc.F90 @@ -81,6 +81,12 @@ module cdeps_datm_comp use datm_datamode_cfsr_mod , only : datm_datamode_cfsr_restart_write use datm_datamode_cfsr_mod , only : datm_datamode_cfsr_restart_read + use datm_datamode_gfs_mod , only : datm_datamode_gfs_advertise + use datm_datamode_gfs_mod , only : datm_datamode_gfs_init_pointers + use datm_datamode_gfs_mod , only : datm_datamode_gfs_advance + use datm_datamode_gfs_mod , only : datm_datamode_gfs_restart_write + use datm_datamode_gfs_mod , only : datm_datamode_gfs_restart_read + implicit none private ! except @@ -295,6 +301,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) trim(datamode) == 'CPLHIST' .or. & trim(datamode) == 'GEFS' .or. & trim(datamode) == 'CFSR' .or. & + trim(datamode) == 'GFS' .or. & trim(datamode) == 'ERA5') then else call shr_sys_abort(' ERROR illegal datm datamode = '//trim(datamode)) @@ -327,6 +334,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) case ('CFSR') call datm_datamode_cfsr_advertise(exportState, fldsExport, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case ('GFS') + call datm_datamode_gfs_advertise(exportState, fldsExport, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select end subroutine InitializeAdvertise @@ -448,7 +458,7 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep real(r8) :: nextsw_cday - logical :: restart_write ! restart alarm is ringing + logical :: restart_write ! restart alarm is ringing integer :: next_ymd ! model date integer :: next_tod ! model sec into model date integer :: yr, mon, day ! year, month, day @@ -570,6 +580,9 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe case('CFSR') call datm_datamode_cfsr_init_pointers(exportState, sdat, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('GFS') + call datm_datamode_gfs_init_pointers(exportState, sdat, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select ! Read restart if needed @@ -589,6 +602,8 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe call datm_datamode_gefs_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) case('CFSR') call datm_datamode_cfsr_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) + case('GFS') + call datm_datamode_gfs_restart_read(restfilm, inst_suffix, logunit, my_task, mpicom, sdat) end select end if @@ -643,6 +658,10 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe call datm_datamode_cfsr_advance(exportstate, masterproc, logunit, mpicom, target_ymd, & target_tod, sdat%model_calendar, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('GFS') + call datm_datamode_gfs_advance(exportstate, masterproc, logunit, mpicom, target_ymd, & + target_tod, sdat%model_calendar, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select ! Write restarts if needed @@ -671,6 +690,10 @@ subroutine datm_comp_run(importState, exportState, target_ymd, target_tod, targe call datm_datamode_cfsr_restart_write(case_name, inst_suffix, target_ymd, target_tod, & logunit, my_task, sdat) if (ChkErr(rc,__LINE__,u_FILE_u)) return + case('GFS') + call datm_datamode_gfs_restart_write(case_name, inst_suffix, target_ymd, target_tod, & + logunit, my_task, sdat) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end select end if diff --git a/datm/datm_datamode_gfs_mod.F90 b/datm/datm_datamode_gfs_mod.F90 new file mode 100644 index 000000000..f918c899e --- /dev/null +++ b/datm/datm_datamode_gfs_mod.F90 @@ -0,0 +1,252 @@ +module datm_datamode_gfs_mod + + use ESMF , only : ESMF_State, ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use NUOPC , only : NUOPC_Advertise + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_precip_mod , only : shr_precip_partition_rain_snow_ramp + use shr_mpi_mod , only : shr_mpi_max + use shr_const_mod , only : shr_const_tkfrz, shr_const_rhofw, shr_const_rdair + use dshr_methods_mod , only : dshr_state_getfldptr, chkerr + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer + use dshr_mod , only : dshr_restart_read, dshr_restart_write + use dshr_strdata_mod , only : shr_strdata_type + use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add + + implicit none + private ! except + + public :: datm_datamode_gfs_advertise + public :: datm_datamode_gfs_init_pointers + public :: datm_datamode_gfs_advance + public :: datm_datamode_gfs_restart_write + public :: datm_datamode_gfs_restart_read + + ! export state data + real(r8), pointer :: Sa_z(:) => null() + real(r8), pointer :: Sa_u(:) => null() + real(r8), pointer :: Sa_v(:) => null() + real(r8), pointer :: Sa_tbot(:) => null() + real(r8), pointer :: Sa_shum(:) => null() + real(r8), pointer :: Sa_pbot(:) => null() + real(r8), pointer :: Sa_u10m(:) => null() + real(r8), pointer :: Sa_v10m(:) => null() + real(r8), pointer :: Sa_t2m(:) => null() + real(r8), pointer :: Sa_q2m(:) => null() + real(r8), pointer :: Sa_pslv(:) => null() + real(r8), pointer :: Faxa_lwdn(:) => null() + real(r8), pointer :: Faxa_rain(:) => null() + real(r8), pointer :: Faxa_snow(:) => null() + real(r8), pointer :: Faxa_swndr(:) => null() + real(r8), pointer :: Faxa_swndf(:) => null() + real(r8), pointer :: Faxa_swvdr(:) => null() + real(r8), pointer :: Faxa_swvdf(:) => null() + + ! stream data + real(r8), pointer :: strm_mask(:) => null() + + real(r8) :: tbotmax ! units detector + real(r8) :: maskmax ! units detector + + real(r8) , parameter :: tKFrz = SHR_CONST_TKFRZ + real(r8) , parameter :: rdair = SHR_CONST_RDAIR ! dry air gas constant ~ J/K/kg + real(r8) , parameter :: rhofw = SHR_CONST_RHOFW ! density of fresh water ~ kg/m^3 + + character(*), parameter :: nullstr = 'undefined' + character(*), parameter :: rpfile = 'rpointer.atm' + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine datm_datamode_gfs_advertise(exportState, fldsexport, & + flds_scalar_name, rc) + + ! input/output variables + type(esmf_State) , intent(inout) :: exportState + type(fldlist_type) , pointer :: fldsexport + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(out) :: rc + + ! local variables + type(fldlist_type), pointer :: fldList + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_fldList_add(fldsExport, trim(flds_scalar_name)) + call dshr_fldList_add(fldsExport, 'Sa_z' ) + call dshr_fldList_add(fldsExport, 'Sa_u' ) + call dshr_fldList_add(fldsExport, 'Sa_v' ) + call dshr_fldList_add(fldsExport, 'Sa_tbot' ) + call dshr_fldList_add(fldsExport, 'Sa_pbot' ) + call dshr_fldList_add(fldsExport, 'Sa_shum' ) + call dshr_fldList_add(fldsExport, 'Sa_u10m' ) + call dshr_fldList_add(fldsExport, 'Sa_v10m' ) + call dshr_fldList_add(fldsExport, 'Sa_t2m' ) + call dshr_fldList_add(fldsExport, 'Sa_q2m' ) + call dshr_fldList_add(fldsExport, 'Sa_pslv' ) + call dshr_fldList_add(fldsExport, 'Faxa_rain' ) + call dshr_fldList_add(fldsExport, 'Faxa_snow' ) + call dshr_fldList_add(fldsExport, 'Faxa_swndr' ) + call dshr_fldList_add(fldsExport, 'Faxa_swvdr' ) + call dshr_fldList_add(fldsExport, 'Faxa_swndf' ) + call dshr_fldList_add(fldsExport, 'Faxa_swvdf' ) + call dshr_fldList_add(fldsExport, 'Faxa_lwdn' ) + + fldlist => fldsExport ! the head of the linked list + do while (associated(fldlist)) + call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('(datm_comp_advertise): Fr_atm '//trim(fldList%stdname), ESMF_LOGMSG_INFO) + fldList => fldList%next + enddo + + end subroutine datm_datamode_gfs_advertise + + !=============================================================================== + subroutine datm_datamode_gfs_init_pointers(exportState, sdat, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + type(shr_strdata_type) , intent(in) :: sdat + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(datm_init_pointers): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! initialize pointers for module level stream arrays + call shr_strdata_get_stream_pointer( sdat, 'Sa_mask' , strm_mask , rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get export state pointers + call dshr_state_getfldptr(exportState, 'Sa_z' , fldptr1=Sa_z , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_u' , fldptr1=Sa_u , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_v' , fldptr1=Sa_v , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_tbot' , fldptr1=Sa_tbot , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pbot' , fldptr1=Sa_pbot , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_shum' , fldptr1=Sa_shum , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_u10m' , fldptr1=Sa_u10m , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_v10m' , fldptr1=Sa_v10m , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_t2m' , fldptr1=Sa_t2m , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_q2m' , fldptr1=Sa_q2m , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Sa_pslv' , fldptr1=Sa_pslv , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_rain' , fldptr1=Faxa_rain , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_snow' , fldptr1=Faxa_snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swvdr' , fldptr1=Faxa_swvdr , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swvdf' , fldptr1=Faxa_swvdf , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swndr' , fldptr1=Faxa_swndr , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_swndf' , fldptr1=Faxa_swndf , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_datamode_gfs_init_pointers + + !=============================================================================== + subroutine datm_datamode_gfs_advance(exportstate, masterproc, logunit, mpicom, target_ymd, target_tod, model_calendar, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + logical , intent(in) :: masterproc + integer , intent(in) :: logunit + integer , intent(in) :: mpicom + integer , intent(in) :: target_ymd + integer , intent(in) :: target_tod + character(len=*) , intent(in) :: model_calendar + integer , intent(out) :: rc + + ! local variables + logical :: first_time = .true. + integer :: n ! indices + integer :: lsize ! size of attr vect + real(r8) :: rtmp + real(r8) :: tbot, pbot + character(len=*), parameter :: subname='(datm_datamode_gfs_advance): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lsize = size(strm_mask) + + if (first_time) then + ! determine tbotmax (see below for use) + rtmp = maxval(Sa_tbot(:)) + call shr_mpi_max(rtmp, tbotmax, mpicom, 'datm_tbot', all=.true.) + if (masterproc) write(logunit,*) trim(subname),' tbotmax = ',tbotmax + + ! determine maskmax (see below for use) + rtmp = maxval(strm_mask(:)) + call shr_mpi_max(rtmp, maskmax, mpicom, 'datm_mask', all=.true.) + if (masterproc) write(logunit,*) trim(subname),' maskmax = ',maskmax + + ! reset first_time + first_time = .false. + end if + + do n = 1, lsize + !--- temperature --- + if (tbotmax < 50.0_r8) Sa_tbot(n) = Sa_tbot(n) + tkFrz + ! Limit very cold forcing to 180K + Sa_tbot(n) = max(180._r8, Sa_tbot(n)) + end do + + end subroutine datm_datamode_gfs_advance + + !=============================================================================== + subroutine datm_datamode_gfs_restart_write(case_name, inst_suffix, ymd, tod, & + logunit, my_task, sdat) + + ! input/output variables + character(len=*) , intent(in) :: case_name + character(len=*) , intent(in) :: inst_suffix + integer , intent(in) :: ymd ! model date + integer , intent(in) :: tod ! model sec into model date + integer , intent(in) :: logunit + integer , intent(in) :: my_task + type(shr_strdata_type) , intent(inout) :: sdat + !------------------------------------------------------------------------------- + + call dshr_restart_write(rpfile, case_name, 'datm', inst_suffix, ymd, tod, & + logunit, my_task, sdat) + + end subroutine datm_datamode_gfs_restart_write + + !=============================================================================== + subroutine datm_datamode_gfs_restart_read(rest_filem, inst_suffix, logunit, my_task, mpicom, sdat) + + ! input/output arguments + character(len=*) , intent(inout) :: rest_filem + character(len=*) , intent(in) :: inst_suffix + integer , intent(in) :: logunit + integer , intent(in) :: my_task + integer , intent(in) :: mpicom + type(shr_strdata_type) , intent(inout) :: sdat + !------------------------------------------------------------------------------- + + call dshr_restart_read(rest_filem, rpfile, inst_suffix, nullstr, logunit, my_task, mpicom, sdat) + + end subroutine datm_datamode_gfs_restart_read + +end module datm_datamode_gfs_mod