From d86f4056d24e2243ef0d9148d92839cb636cfd22 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 25 Oct 2023 14:31:51 -0600 Subject: [PATCH 01/31] initial work for inline cdeps --- mediator/med.F90 | 16 ++++++++ mediator/med_phases_cdeps_mod.F90 | 68 +++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+) create mode 100644 mediator/med_phases_cdeps_mod.F90 diff --git a/mediator/med.F90 b/mediator/med.F90 index 9bb936f60..31f67486a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -123,6 +123,9 @@ subroutine SetServices(gcomp, rc) use med_diag_mod , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice use med_fraction_mod , only: med_fraction_init, med_fraction_set use med_phases_profile_mod , only: med_phases_profile +#ifdef CDEPS_INLINE + use med_phases_cdeps_mod , only: med_phases_cdeps_run +#endif ! input/output variables type(ESMF_GridComp) :: gcomp @@ -505,6 +508,19 @@ subroutine SetServices(gcomp, rc) specPhaselabel="med_phases_diag_print", specRoutine=NUOPC_NoOp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CDEPS_INLINE + !------------------ + ! phase routine for cdeps inline capabilty + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_cdeps_run"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_cdeps_run", specRoutine=med_phases_cdeps_run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + !------------------ ! attach specializing method(s) ! -> NUOPC specializes by default --->>> first need to remove the default diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 new file mode 100644 index 000000000..86bf8c0ee --- /dev/null +++ b/mediator/med_phases_cdeps_mod.F90 @@ -0,0 +1,68 @@ +module med_phases_cdeps_mod + + use ESMF, only: ESMF_GridComp + use ESMF, only: ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO + + use dshr_strdata_mod, only: shr_strdata_type + use dshr_strdata_mod, only: shr_strdata_init_from_inline + use perf_mod , only: t_startf, t_stopf + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public interf aces + !-------------------------------------------------------------------------- + + public med_phases_cdeps_run + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + + + character(*),parameter :: u_FILE_u = __FILE__ + +!============================================================================ +contains +!============================================================================ + + subroutine med_phases_cdeps_run(gcomp, rc) + + !------------------------------------------------------------------------ + ! Use CDEPS inline capability to read in data + !------------------------------------------------------------------------ + + use ESMF, only : ESMF_GridComp + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + character(len=*) , parameter :: subname='(med_phases_cdeps_run)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + !if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + !endif + + + !if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + !endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_cdeps_run + +end module med_phases_cdeps_mod From 5510ad7c3e68bf3cf08ec8b279618f793e0b9b85 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 26 Oct 2023 23:59:07 -0600 Subject: [PATCH 02/31] more work for cdeps inline --- mediator/med_internalstate_mod.F90 | 9 +- mediator/med_phases_cdeps_mod.F90 | 188 ++++++++++++++++++++++++++--- 2 files changed, 174 insertions(+), 23 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 66e2eb1db..9aceac49b 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -147,10 +147,11 @@ module med_internalstate_mod ! FBImp(n,n) = NState_Imp(n), copied in connector post phase ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! Import/export States and field bundles (the field bundles have the scalar fields removed) - type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid - type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid - type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids - type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid + type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid + type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid + type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids + type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid + type(ESMF_FieldBundle) , pointer :: FBExpInline(:) ! Export data coming from CDEPS inline for various components, on their grid ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 86bf8c0ee..900e0aac9 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -1,33 +1,61 @@ module med_phases_cdeps_mod - use ESMF, only: ESMF_GridComp + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF, only: ESMF_Mesh + use ESMF, only: ESMF_GridComp, ESMF_GridCompGet use ESMF, only: ESMF_LogWrite + use ESMF, only: ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_FieldBundleGet + use ESMF, only: ESMF_StateIsCreated + use ESMF, only: ESMF_GridCompGetInternalState use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO - use dshr_strdata_mod, only: shr_strdata_type - use dshr_strdata_mod, only: shr_strdata_init_from_inline - use perf_mod , only: t_startf, t_stopf + use med_internalstate_mod, only: InternalState + use med_internalstate_mod, only: compname, compatm, compocn + use perf_mod , only: t_startf, t_stopf + use med_kind_mod , only: cl => shr_kind_cl + use med_kind_mod , only: r8 => shr_kind_r8 + use med_constants_mod , only: dbug_flag => med_constants_dbug_flag + use med_utils_mod , only: chkerr => med_utils_ChkErr + use med_methods_mod , only: med_methods_FB_FldChk + use med_methods_mod , only: med_methods_FB_getFieldN + use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + + use dshr_strdata_mod , only: shr_strdata_type + use dshr_strdata_mod , only: shr_strdata_init_from_inline + use dshr_strdata_mod , only: shr_strdata_advance implicit none private !-------------------------------------------------------------------------- - ! Public interf aces + ! Public interfaces !-------------------------------------------------------------------------- public med_phases_cdeps_run - !-------------------------------------------------------------------------- - ! Private interfaces - !-------------------------------------------------------------------------- - - - !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- - + type config + integer :: year_first + integer :: year_last + integer :: year_align + integer :: offset + real(r8) :: dtlimit + character(len=cl) :: mesh_filename + character(len=cl), allocatable :: data_filename(:) + character(len=cl), allocatable :: fld_list(:) + character(len=cl), allocatable :: fld_list_model(:) + character(len=cl) :: mapalgo + character(len=cl) :: taxmode + character(len=cl) :: tintalgo + character(len=cl) :: name + end type config + + type(config), allocatable :: stream(:) ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:) ! input data stream character(*),parameter :: u_FILE_u = __FILE__ @@ -47,22 +75,144 @@ subroutine med_phases_cdeps_run(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - character(len=*) , parameter :: subname='(med_phases_cdeps_run)' + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Mesh) :: meshdst + type(ESMF_Field) :: flddst + integer :: n1, n2, item, localPet + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + logical, save :: first_time = .true. + character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - !if (dbug_flag > 5) then + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - !endif - - - !if (dbug_flag > 5) then + endif + + ! Get the internal state from gcomp + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query component + call ESMF_GridCompGet(gcomp, clock=clock, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize cdeps inline + if (first_time) then + ! Set components in both side + ! TODO: This needs to be dynamic and read from hconfig file + n1 = compocn + n2 = compatm + + ! Allocate data structures + ! TODO: The number of stream will come from config file + if (.not. allocated(sdat)) allocate(sdat(1)) + if (.not. allocated(stream)) allocate(stream(1)) + + ! Check coupling direction + if (n1 /= n2) then + if (is_local%wrap%med_coupling_active(n1,n2)) then + ! Get destination field + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n2,n2), 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get destination field mesh + call ESMF_FieldGet(flddst, mesh=meshdst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize cdeps inline + call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = 6, & + compname = trim(compname(n2)), & + model_clock = clock, model_mesh = meshdst, & + stream_meshfile = 'INPUT_DATA/ESMFmesh.nc', & + stream_filenames = (/ 'INPUT_DATA/tsfc_fv3grid_202318612_sub.nc' /), & + stream_yearFirst = 2023, & + stream_yearLast = 2023, & + stream_yearAlign = 2023, & + stream_fldlistFile = (/ 'twsfc' /), & + stream_fldListModel = (/ 'twsfc' /), & + stream_lev_dimname = 'null', & + stream_mapalgo = 'bilinear', & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.5d0, & + stream_tintalgo = 'linear', & + stream_name = 'fvcom great lakes', & + rc = rc) + + ! Create FB to store data + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then + call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & + is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + ! Set flag to false + first_time = .false. + end if + + ! Get current time + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! Run inline cdeps and read data + n1 = compocn + n2 = compatm + + if (n1 /= n2) then + if (is_local%wrap%med_coupling_active(n1,n2)) then + call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields provided by CDEPS inline and add it to FB + do item = 1, 1 !size(config%stream_fldListFile) + ! Get field + !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) + call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Check FB for field + !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then + ! + !end if + + end do + end if + end if + + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - !endif + endif call t_stopf('MED:'//subname) end subroutine med_phases_cdeps_run + !========================================================================== + + subroutine read_config() + + !------------------------------------------------------------------------ + ! Read YAML based Hconfig file + !------------------------------------------------------------------------ + + + + end subroutine read_config + end module med_phases_cdeps_mod From 6438f3dc38d05f9e5bf619a0d5f59b0c5bf953bf Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 2 Nov 2023 11:36:59 -0600 Subject: [PATCH 03/31] more work for inline --- mediator/med_methods_mod.F90 | 67 ++++++++++++++ mediator/med_phases_cdeps_mod.F90 | 139 ++++++++++++++++++------------ 2 files changed, 150 insertions(+), 56 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 649c9c511..a62af95b7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -44,6 +44,7 @@ module med_methods_mod public med_methods_FB_init_pointer public med_methods_FB_reset public med_methods_FB_diagnose + public med_methods_FB_write public med_methods_FB_FldChk public med_methods_FB_GetFldPtr public med_methods_FB_getNameN @@ -999,6 +1000,72 @@ subroutine med_methods_FB_diagnose(FB, string, rc) end subroutine med_methods_FB_diagnose !----------------------------------------------------------------------------- + + subroutine med_methods_FB_write(FB, string, rc) + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF, only : ESMF_Field, ESMF_FieldGet + use ESMF, only : ESMF_FieldWriteVTK + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + type(ESMF_Field) :: lfield + character(len=*), parameter :: subname='(med_methods_FB_write)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string)//'_' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + call ESMF_FieldWriteVTK(lfield, trim(lstring)//trim(lfieldnamelist(n)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + end do + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine med_methods_FB_write + + !----------------------------------------------------------------------------- #ifdef DIAGNOSE subroutine med_methods_Array_diagnose(array, string, rc) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 900e0aac9..f6f4bb736 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -11,6 +11,7 @@ module med_phases_cdeps_mod use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO use med_internalstate_mod, only: InternalState + use med_internalstate_mod, only: logunit use med_internalstate_mod, only: compname, compatm, compocn use perf_mod , only: t_startf, t_stopf use med_kind_mod , only: cl => shr_kind_cl @@ -20,6 +21,8 @@ module med_phases_cdeps_mod use med_methods_mod , only: med_methods_FB_FldChk use med_methods_mod , only: med_methods_FB_getFieldN use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only: FB_write => med_methods_FB_write use dshr_strdata_mod , only: shr_strdata_type use dshr_strdata_mod , only: shr_strdata_init_from_inline @@ -85,15 +88,16 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer :: curr_ymd, sec integer :: year, month, day, hour, minute, second logical, save :: first_time = .true. + character(len=cl) :: prefix character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - if (dbug_flag > 5) then + !if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + !endif ! Get the internal state from gcomp nullify(is_local%wrap) @@ -113,8 +117,8 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Allocate data structures ! TODO: The number of stream will come from config file - if (.not. allocated(sdat)) allocate(sdat(1)) - if (.not. allocated(stream)) allocate(stream(1)) + if (.not. allocated(sdat)) allocate(sdat(3)) + if (.not. allocated(stream)) allocate(stream(3)) ! Check coupling direction if (n1 /= n2) then @@ -128,31 +132,38 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize cdeps inline - call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = 6, & + print*, "here 1 "//trim(compname(n2)) + call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = logunit, & compname = trim(compname(n2)), & model_clock = clock, model_mesh = meshdst, & - stream_meshfile = 'INPUT_DATA/ESMFmesh.nc', & - stream_filenames = (/ 'INPUT_DATA/tsfc_fv3grid_202318612_sub.nc' /), & - stream_yearFirst = 2023, & - stream_yearLast = 2023, & - stream_yearAlign = 2023, & - stream_fldlistFile = (/ 'twsfc' /), & - stream_fldListModel = (/ 'twsfc' /), & + !stream_meshfile = 'INPUT_CDEPS/sst_mesh.nc', & + !stream_filenames = (/ 'INPUT_CDEPS/sst20190829_new.nc' /), & + stream_meshfile = 'INPUT_CDEPS/mesh.nc', & + stream_filenames = (/ 'INPUT_CDEPS/sst.day.mean.2019.nc' /), & + stream_yearFirst = 2019, & + stream_yearLast = 2019, & + stream_yearAlign = 2019, & + !stream_fldlistFile = (/ 'TMPSFC' /), & + stream_fldlistFile = (/ 'sst' /), & + stream_fldListModel = (/ 'So_t' /), & stream_lev_dimname = 'null', & stream_mapalgo = 'bilinear', & stream_offset = 0, & - stream_taxmode = 'cycle', & + stream_taxmode = 'limit', & stream_dtlimit = 1.5d0, & stream_tintalgo = 'linear', & - stream_name = 'fvcom great lakes', & + stream_name = 'sst', & rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + print*, "here 2" + ! Create FB to store data - if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then - call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & - is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then + ! call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & + ! is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if end if end if @@ -161,44 +172,60 @@ subroutine med_phases_cdeps_run(gcomp, rc) end if ! Get current time - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Query current time - call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - curr_ymd = abs(year)*10000+month*100+day - sec = hour*3600+minute*60+second - - ! Run inline cdeps and read data - n1 = compocn - n2 = compatm - - if (n1 /= n2) then - if (is_local%wrap%med_coupling_active(n1,n2)) then - call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Loop over fields provided by CDEPS inline and add it to FB - do item = 1, 1 !size(config%stream_fldListFile) - ! Get field - !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) - call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Check FB for field - !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then - ! - !end if - - end do - end if - end if - - if (dbug_flag > 5) then + !call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !! Query current time + !call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !curr_ymd = abs(year)*10000+month*100+day + !sec = hour*3600+minute*60+second + ! print*, "here 3" + + !! Run inline cdeps and read data + !n1 = compocn + !n2 = compatm + + !if (n1 /= n2) then + ! if (is_local%wrap%med_coupling_active(n1,n2)) then + ! print*, "here 4" + ! ! Run cdeps inline adn read data + ! call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Check FB + ! call FB_diagnose(sdat(1)%pstrm(1)%fldbun_model, trim(subname)//": sst", rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Write FB for debugging + ! !if (dbug_flag > 10) then + ! write(prefix, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') "FBExpInline", & + ! year, '-', month, '-', day, '-', sec + ! call FB_write(sdat(1)%pstrm(1)%fldbun_model, prefix, rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! !end if + + + ! ! Loop over fields provided by CDEPS inline and add it to FB + ! !do item = 1, 1 !size(config%stream_fldListFile) + ! ! Get field + ! !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) + ! ! call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) + ! ! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ! Check FB for field + ! !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then + ! ! + ! !end if + + ! !end do + ! end if + !end if + + !if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - endif + !endif call t_stopf('MED:'//subname) end subroutine med_phases_cdeps_run From bcee457fb56ca7e218e52cca1df848fb18b06fa8 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 6 Nov 2023 23:45:22 -0600 Subject: [PATCH 04/31] use esmf config file to get stream information --- mediator/med_internalstate_mod.F90 | 8 +- mediator/med_methods_mod.F90 | 4 +- mediator/med_phases_cdeps_mod.F90 | 312 ++++++++++++++++------------- 3 files changed, 178 insertions(+), 146 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 9aceac49b..fd00d27b7 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,6 +121,7 @@ module med_internalstate_mod ! Present/allowed coupling/active coupling logical flags logical, pointer :: comp_present(:) ! comp present flag logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + logical, pointer :: med_bg_fill_active(:,:) ! use cdeps for background fill integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. @@ -151,7 +152,7 @@ module med_internalstate_mod type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid - type(ESMF_FieldBundle) , pointer :: FBExpInline(:) ! Export data coming from CDEPS inline for various components, on their grid + type(ESMF_FieldBundle) , pointer :: FBExpIn(:) ! Export data for various components, on their grid, CDEPS inline ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -304,6 +305,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Allocate memory now that ncomps is determined allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) + allocate(is_local%wrap%med_bg_fill_active(ncomps,ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) @@ -365,6 +367,10 @@ subroutine med_internalstate_init(gcomp, rc) write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! Initialize flag for background fill + is_local%wrap%med_bg_fill_active(:,:) = .false. + is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. + end subroutine med_internalstate_init !===================================================================== diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index a62af95b7..d4bdab2a7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1028,7 +1028,7 @@ subroutine med_methods_FB_write(FB, string, rc) lstring = '' if (present(string)) then - lstring = trim(string)//'_' + lstring = trim(string) endif ! Determine number of fields in field bundle and allocate memory for lfieldnamelist @@ -1049,7 +1049,7 @@ subroutine med_methods_FB_write(FB, string, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 1) then - call ESMF_FieldWriteVTK(lfield, trim(lstring)//trim(lfieldnamelist(n)), rc=rc) + call ESMF_FieldWriteVTK(lfield, trim(lfieldnamelist(n))//'_'//trim(lstring), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index f6f4bb736..b50809196 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -5,28 +5,31 @@ module med_phases_cdeps_mod use ESMF, only: ESMF_GridComp, ESMF_GridCompGet use ESMF, only: ESMF_LogWrite use ESMF, only: ESMF_Field, ESMF_FieldGet - use ESMF, only: ESMF_FieldBundleGet - use ESMF, only: ESMF_StateIsCreated + use ESMF, only: ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + use ESMF, only: ESMF_FieldBundleCreate use ESMF, only: ESMF_GridCompGetInternalState use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO use med_internalstate_mod, only: InternalState - use med_internalstate_mod, only: logunit - use med_internalstate_mod, only: compname, compatm, compocn + use med_internalstate_mod, only: logunit, maintask + use med_internalstate_mod, only: ncomps, compname, compatm, compocn use perf_mod , only: t_startf, t_stopf use med_kind_mod , only: cl => shr_kind_cl use med_kind_mod , only: r8 => shr_kind_r8 use med_constants_mod , only: dbug_flag => med_constants_dbug_flag use med_utils_mod , only: chkerr => med_utils_ChkErr - use med_methods_mod , only: med_methods_FB_FldChk - use med_methods_mod , only: med_methods_FB_getFieldN - use med_methods_mod , only: FB_init_pointer => med_methods_FB_Init_pointer + use med_methods_mod , only: FB_FldChk => med_methods_FB_FldChk + use med_methods_mod , only: FB_getFieldN => med_methods_FB_getFieldN + use med_methods_mod , only: FB_getNumflds => med_methods_FB_getNumflds + use med_methods_mod , only: FB_init => med_methods_FB_Init use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only: FB_write => med_methods_FB_write + use dshr_mod , only: dshr_pio_init use dshr_strdata_mod , only: shr_strdata_type use dshr_strdata_mod , only: shr_strdata_init_from_inline use dshr_strdata_mod , only: shr_strdata_advance + use dshr_stream_mod , only: shr_stream_init_from_esmfconfig implicit none private @@ -57,8 +60,8 @@ module med_phases_cdeps_mod character(len=cl) :: name end type config - type(config), allocatable :: stream(:) ! stream configuration - type(shr_strdata_type), allocatable :: sdat(:) ! input data stream + type(config) :: stream ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:,:) ! input data stream character(*),parameter :: u_FILE_u = __FILE__ @@ -79,25 +82,27 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - type(ESMF_Mesh) :: meshdst - type(ESMF_Field) :: flddst - integer :: n1, n2, item, localPet - integer :: curr_ymd, sec - integer :: year, month, day, hour, minute, second - logical, save :: first_time = .true. - character(len=cl) :: prefix - character(len=*), parameter :: subname = '(med_phases_cdeps_run)' + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Mesh) :: meshdst + type(ESMF_Field) :: flddst + integer :: i, j, k, l, nflds, streamid + integer :: n1, n2, item, nstreams, localPet + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + logical :: isCreated + logical, save :: first_time = .true. + character(len=cl), allocatable :: fileList(:), varList(:,:) + character(len=cl) :: streamfilename, suffix, fldname + type(shr_strdata_type) :: sdat_config + character(len=*), parameter :: subname = '(med_phases_cdeps_run)' !--------------------------------------- rc = ESMF_SUCCESS call t_startf('MED:'//subname) - !if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - !endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! Get the internal state from gcomp nullify(is_local%wrap) @@ -108,138 +113,159 @@ subroutine med_phases_cdeps_run(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=clock, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Initialize sdat streams + if (.not. allocated(sdat)) allocate(sdat(ncomps,ncomps)) + sdat(:,:)%mainproc = (localPet == 0) + ! Initialize cdeps inline if (first_time) then - ! Set components in both side - ! TODO: This needs to be dynamic and read from hconfig file - n1 = compocn - n2 = compatm - - ! Allocate data structures - ! TODO: The number of stream will come from config file - if (.not. allocated(sdat)) allocate(sdat(3)) - if (.not. allocated(stream)) allocate(stream(3)) - - ! Check coupling direction - if (n1 /= n2) then - if (is_local%wrap%med_coupling_active(n1,n2)) then - ! Get destination field - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n2,n2), 1, flddst, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Get destination field mesh - call ESMF_FieldGet(flddst, mesh=meshdst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize cdeps inline - print*, "here 1 "//trim(compname(n2)) - call shr_strdata_init_from_inline(sdat(1), my_task = localPet, logunit = logunit, & - compname = trim(compname(n2)), & - model_clock = clock, model_mesh = meshdst, & - !stream_meshfile = 'INPUT_CDEPS/sst_mesh.nc', & - !stream_filenames = (/ 'INPUT_CDEPS/sst20190829_new.nc' /), & - stream_meshfile = 'INPUT_CDEPS/mesh.nc', & - stream_filenames = (/ 'INPUT_CDEPS/sst.day.mean.2019.nc' /), & - stream_yearFirst = 2019, & - stream_yearLast = 2019, & - stream_yearAlign = 2019, & - !stream_fldlistFile = (/ 'TMPSFC' /), & - stream_fldlistFile = (/ 'sst' /), & - stream_fldListModel = (/ 'So_t' /), & - stream_lev_dimname = 'null', & - stream_mapalgo = 'bilinear', & - stream_offset = 0, & - stream_taxmode = 'limit', & - stream_dtlimit = 1.5d0, & - stream_tintalgo = 'linear', & - stream_name = 'sst', & - rc = rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - print*, "here 2" - - - ! Create FB to store data - !if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n2), rc=rc)) then - ! call FB_init_pointer(is_local%wrap%NStateExp(n2), is_local%wrap%FBExpInline(n2), & - ! is_local%wrap%flds_scalar_name, name='FBExpInline'//trim(compname(n2)), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - end if - end if + ! Init PIO + call dshr_pio_init(gcomp, sdat_config, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Read stream configuration file + ! TODO: At this point it only suports ESMF config format (XML?) + streamfilename = 'stream.config' + call shr_stream_init_from_esmfconfig(streamfilename, sdat_config%stream, logunit, & + sdat_config%pio_subsystem, sdat_config%io_type, sdat_config%io_format, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get number of streams + nstreams = size(sdat_config%stream) + + ! Loop over coupling directions and try to find field match in given streams + do n1 = 1, ncomps + do n2 = 1, ncomps + ! Check for coupling direction and background fill + if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_bg_fill_active(n1,n2)) then + ! Get number of fields + call FB_getNumflds(is_local%wrap%FBImp(n1,n2), trim(subname), nflds, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and try to find it in the given stream + do i = 1, nflds + ! Query destination field + call FB_getFieldN(is_local%wrap%FBImp(n1,n2), i, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query destination field name and its mesh + call ESMF_FieldGet(flddst, mesh=meshdst, name=fldname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Check if any field in FB in the given stream + ! NOTE: Single stream could provide multiple fields !!! + streamid = 0 + do j = 1, nstreams + do k = 1, sdat_config%stream(j)%nvars + if (trim(sdat_config%stream(j)%varlist(k)%nameinmodel) == trim(fldname)) then + streamid = j + end if + end do + end do + + ! If match is found, then initialize cdeps inline for the stream + if (streamid /= 0) then + ! Debug print + if (maintask) then + write(logunit,'(a,i)') trim(subname)//": "//trim(fldname)//" is found in stream ", streamid + end if + + ! Allocate temporary variable to store file names in the stream + allocate(fileList(sdat_config%stream(streamid)%nfiles)) + allocate(varList(sdat_config%stream(streamid)%nvars,2)) + + ! Fill file abd variable lists with data + do l = 1, sdat_config%stream(streamid)%nfiles + fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + end do + do l = 1, sdat_config%stream(streamid)%nvars + varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) + varList(l,2) = trim(sdat_config%stream(streamid)%varlist(l)%nameinmodel) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": variable ", l, trim(varList(l,1))//" -> "//trim(varList(l,2)) + end do + + ! Set PIO related variables + sdat(n1,n2)%pio_subsystem => sdat_config%pio_subsystem + sdat(n1,n2)%io_type = sdat_config%io_type + sdat(n1,n2)%io_format = sdat_config%io_format + + ! Init stream + call shr_strdata_init_from_inline(sdat(n1,n2), my_task=localPet, logunit=logunit, & + compname = 'cmeps', model_clock=clock, model_mesh=meshdst, & + stream_meshfile=trim(sdat_config%stream(streamid)%meshfile), & + stream_filenames=fileList, & + stream_yearFirst=sdat_config%stream(streamid)%yearFirst, & + stream_yearLast=sdat_config%stream(streamid)%yearLast, & + stream_yearAlign=sdat_config%stream(streamid)%yearAlign, & + stream_fldlistFile=varList(:,1), & + stream_fldListModel=varList(:,2), & + stream_lev_dimname=trim(sdat_config%stream(streamid)%lev_dimname), & + stream_mapalgo=trim(sdat_config%stream(streamid)%mapalgo), & + stream_offset=sdat_config%stream(streamid)%offset, & + stream_taxmode=trim(sdat_config%stream(streamid)%taxmode), & + stream_dtlimit=sdat_config%stream(streamid)%dtlimit, & + stream_tintalgo=trim(sdat_config%stream(streamid)%tInterpAlgo), & + stream_name=trim(compname(n1))//'_'//trim(compname(n2)), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Remove temporary variables + deallocate(fileList) + deallocate(varList) + end if + end do ! nflds + end if + end do ! n2 + end do ! n1 ! Set flag to false first_time = .false. end if ! Get current time - !call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !! Query current time - !call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !curr_ymd = abs(year)*10000+month*100+day - !sec = hour*3600+minute*60+second - ! print*, "here 3" - - !! Run inline cdeps and read data - !n1 = compocn - !n2 = compatm - - !if (n1 /= n2) then - ! if (is_local%wrap%med_coupling_active(n1,n2)) then - ! print*, "here 4" - ! ! Run cdeps inline adn read data - ! call shr_strdata_advance(sdat(1), ymd=curr_ymd, tod=sec, logunit=6, istr=trim(compname(n2)), rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Check FB - ! call FB_diagnose(sdat(1)%pstrm(1)%fldbun_model, trim(subname)//": sst", rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Write FB for debugging - ! !if (dbug_flag > 10) then - ! write(prefix, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') "FBExpInline", & - ! year, '-', month, '-', day, '-', sec - ! call FB_write(sdat(1)%pstrm(1)%fldbun_model, prefix, rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! !end if - - - ! ! Loop over fields provided by CDEPS inline and add it to FB - ! !do item = 1, 1 !size(config%stream_fldListFile) - ! ! Get field - ! !call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName=trim(config%stream_fldListFile(item)), field=flddst, rc=rc) - ! ! call ESMF_FieldBundleGet(sdat(1)%pstrm(1)%fldbun_model, fieldName='So_t', field=flddst, rc=rc) - ! ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! ! Check FB for field - ! !if (med_methods_FB_FldChk(is_local%wrap%FBExpInline(n2), trim(config%stream_fldListFile(item)))) then - ! ! - ! !end if - - ! !end do - ! end if - !end if - - !if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - !endif - call t_stopf('MED:'//subname) - - end subroutine med_phases_cdeps_run - - !========================================================================== + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - subroutine read_config() + ! Query current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - !------------------------------------------------------------------------ - ! Read YAML based Hconfig file - !------------------------------------------------------------------------ + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! Read data if stream initialized + do n1 = 1, ncomps + do n2 = 1, ncomps + if (size(sdat(n1,n2)%stream) > 0) then + ! Debug print + if (maintask) then + write(logunit,'(a,i)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) + end if + + ! Read data + call shr_strdata_advance(sdat(n1,n2), ymd=curr_ymd, tod=sec, logunit=logunit, & + istr=trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check FB + call FB_diagnose(sdat(n1,n2)%pstrm(1)%fldbun_model, & + trim(subname)//':'//trim(compname(n1))//'_'//trim(compname(n2)), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Write FB for debugging + if (dbug_flag > 10) then + write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec + call FB_write(sdat(n1,n2)%pstrm(1)%fldbun_model, suffix, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end do + end do + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call t_stopf('MED:'//subname) - end subroutine read_config + end subroutine med_phases_cdeps_run end module med_phases_cdeps_mod From 96c81b66a141c8e4b1c3f5ff94b106fa781a74a0 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 7 Nov 2023 00:42:20 -0600 Subject: [PATCH 05/31] more work for inline capability --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_phases_cdeps_mod.F90 | 20 +++++++++++++++++--- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fd00d27b7..cdfbbfb2f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -312,6 +312,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) allocate(is_local%wrap%FBExp(ncomps)) + allocate(is_local%wrap%FBExpIn(ncomps)) allocate(is_local%wrap%packed_data_ocnalb_o2a(nmappers)) allocate(is_local%wrap%packed_data_aoflux_o2a(nmappers)) allocate(is_local%wrap%RH(ncomps,ncomps,nmappers)) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index b50809196..272cefc02 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -24,6 +24,7 @@ module med_phases_cdeps_mod use med_methods_mod , only: FB_init => med_methods_FB_Init use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only: FB_write => med_methods_FB_write + use med_methods_mod , only: FB_GetFldPtr => med_methods_FB_GetFldPtr use dshr_mod , only: dshr_pio_init use dshr_strdata_mod , only: shr_strdata_type @@ -91,7 +92,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) integer :: n1, n2, item, nstreams, localPet integer :: curr_ymd, sec integer :: year, month, day, hour, minute, second - logical :: isCreated + logical :: found logical, save :: first_time = .true. character(len=cl), allocatable :: fileList(:), varList(:,:) character(len=cl) :: streamfilename, suffix, fldname @@ -143,6 +144,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields and try to find it in the given stream + found = .false. do i = 1, nflds ! Query destination field call FB_getFieldN(is_local%wrap%FBImp(n1,n2), i, flddst, rc) @@ -213,8 +215,17 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Remove temporary variables deallocate(fileList) deallocate(varList) + + ! Set flag + found = .true. end if end do ! nflds + + ! Create empty FB + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBExpIn(n2), rc=rc) .and. found) then + is_local%wrap%FBExpIn(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if end do ! n2 end do ! n1 @@ -252,11 +263,14 @@ subroutine med_phases_cdeps_run(gcomp, rc) call FB_diagnose(sdat(n1,n2)%pstrm(1)%fldbun_model, & trim(subname)//':'//trim(compname(n1))//'_'//trim(compname(n2)), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + + ! Point FB from internal one + is_local%wrap%FBExpIn(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model + ! Write FB for debugging if (dbug_flag > 10) then write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec - call FB_write(sdat(n1,n2)%pstrm(1)%fldbun_model, suffix, rc) + call FB_write(is_local%wrap%FBExpIn(n2), suffix, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if From 794e6917ebfae50e6f1824c0f7dde5e4a0cc3950 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 9 Nov 2023 12:05:25 -0600 Subject: [PATCH 06/31] enabling setting source and destination mask for interpolation --- mediator/med_phases_cdeps_mod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 272cefc02..4c78da123 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -209,9 +209,15 @@ subroutine med_phases_cdeps_run(gcomp, rc) stream_dtlimit=sdat_config%stream(streamid)%dtlimit, & stream_tintalgo=trim(sdat_config%stream(streamid)%tInterpAlgo), & stream_name=trim(compname(n1))//'_'//trim(compname(n2)), & + stream_src_mask=sdat_config%stream(streamid)%src_mask_val, & + stream_dst_mask=sdat_config%stream(streamid)%dst_mask_val, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Print out source and destination mask used in the stream + if (maintask) write(logunit,'(a,2i2)') trim(subname)//": mask values src, dst ", & + sdat_config%stream(streamid)%src_mask_val, sdat_config%stream(streamid)%dst_mask_val + ! Remove temporary variables deallocate(fileList) deallocate(varList) From 17b127d4029b49354ade76c85ecbe7a02fd9f0e1 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 10 Nov 2023 23:54:48 -0600 Subject: [PATCH 07/31] more work for cdeps inline --- mediator/med_internalstate_mod.F90 | 6 +- mediator/med_map_mod.F90 | 171 ++++++++++++++++++++------- mediator/med_phases_cdeps_mod.F90 | 8 +- mediator/med_phases_prep_atm_mod.F90 | 1 + 4 files changed, 140 insertions(+), 46 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index cdfbbfb2f..d07923d35 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -152,7 +152,6 @@ module med_internalstate_mod type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid - type(ESMF_FieldBundle) , pointer :: FBExpIn(:) ! Export data for various components, on their grid, CDEPS inline ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -175,6 +174,9 @@ module med_internalstate_mod ! Fractions type(ESMF_FieldBundle), pointer :: FBfrac(:) ! Fraction data for various components, on their grid + ! Data + type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn @@ -312,7 +314,6 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) allocate(is_local%wrap%FBExp(ncomps)) - allocate(is_local%wrap%FBExpIn(ncomps)) allocate(is_local%wrap%packed_data_ocnalb_o2a(nmappers)) allocate(is_local%wrap%packed_data_aoflux_o2a(nmappers)) allocate(is_local%wrap%RH(ncomps,ncomps,nmappers)) @@ -320,6 +321,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%packed_data(ncomps,ncomps,nmappers)) allocate(is_local%wrap%FBfrac(ncomps)) allocate(is_local%wrap%FBArea(ncomps)) + allocate(is_local%wrap%FBData(ncomps)) allocate(is_local%wrap%mesh_info(ncomps)) ! Determine component names diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 54bcbb154..75dc8189f 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -919,7 +919,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end subroutine med_map_packed_field_create !================================================================================ - subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_data, routehandles, rc) + subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -934,28 +934,33 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d use med_internalstate_mod , only : packed_data_type ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FBSrc - type(ESMF_FieldBundle) , intent(inout) :: FBDst - type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types - type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source - type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in) :: FBSrc + type(ESMF_FieldBundle) , intent(inout) :: FBDst + type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types + type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source + type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + integer, optional , intent(out) :: rc ! local variables - integer :: nf, nu, np, n - integer :: fieldcount - integer :: mapindex - integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) - type(ESMF_Field), pointer :: fieldlist_dst(:) - real(r8), pointer :: data_norm(:) - real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' + integer :: nf, nu, np, n, nfd + integer :: fieldcount, fieldcount_dat + integer :: mapindex + integer :: ungriddedUBound(1) + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) + type(ESMF_Field) :: field_fracsrc + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) + type(ESMF_Field), pointer :: fieldlist_dat(:) + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) + character(cl) :: field_name + character(cl), allocatable :: field_namelist_dat(:) + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -977,6 +982,19 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d fieldcount=0 endif + ! Get field count for FBDat if it is given and created + fieldcount_dat = 0 + if (present(FBdat)) then + if (ESMF_FieldBundleIsCreated(FBdat)) then + call ESMF_FieldBundleGet(FBDat, fieldCount=fieldcount_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldlist_dat(fieldcount_dat)) + allocate(field_namelist_dat(fieldcount_dat)) + call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if ! Loop over mapping types do mapindex = 1,nmappers @@ -1027,8 +1045,63 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end if end if end do + + ! Nullify pointers + nullify(dataptr2d_packed) + nullify(dataptr2d) + nullify(dataptr1d) + call t_stopf('MED:'//trim(subname)//' copy from src') + ! ----------------------------------- + ! Fill destination field with background data provided by CDEPS inline + ! ----------------------------------- + + if (fieldcount_dat > 0) then + ! First get the pointer for the packed destination data + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and fill it if there is a match + do nf = 1,fieldcount + ! Get the indices into the packed data structure + np = packed_data(mapindex)%fldindex(nf) + if (np > 0) then + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//" serach for "//trim(field_name) + + ! Check if field has match in data fields + do nfd = 1, fieldcount_dat + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd)) + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + if (maintask) write(logunit,'(a)') trim(subname)//" filling with background data " + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get pointer from destination field and fill it with data + if (ungriddedUBound(1) > 0) then + call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! TODO: Currently assumes same data along the ungridded dimension + do nu = 1,ungriddedUBound(1) + dataptr2d_packed(np+nu-1,:) = dataptr(:) + end do + else + call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_packed(np,:) = dataptr(:) + end if + exit + end if + end do + end if + end do + end if + ! ----------------------------------- ! Do the mapping ! ----------------------------------- @@ -1067,7 +1140,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d field_src=packed_data(mapindex)%field_src, & field_dst=packed_data(mapindex)%field_dst, & routehandles=routehandles, & - maptype=mapindex, rc=rc) + maptype=mapindex, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Obtain unity normalization factor and multiply @@ -1126,8 +1200,12 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end do ! end of loop over mapindex if (ESMF_FieldBundleIsCreated(FBsrc)) then - deallocate(fieldlist_src) - deallocate(fieldlist_dst) + deallocate(fieldlist_src) + deallocate(fieldlist_dst) + end if + if (fieldcount_dat > 0) then + deallocate(fieldlist_dat) + deallocate(field_namelist_dat) end if call t_stopf('MED:'//subname) @@ -1263,18 +1341,19 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL use ESMF , only : ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle + use ESMF , only : ESMF_FieldWriteVTK use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod use med_internalstate_mod , only : mapconsd, mapconsf use med_internalstate_mod , only : mapfillv_bilnr use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables - type(ESMF_Field) , intent(in) :: field_src - type(ESMF_Field) , intent(inout) :: field_dst - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(in) :: maptype - character(len=*) , intent(in), optional :: fldname - integer , intent(out) :: rc + type(ESMF_Field) , intent(in) :: field_src + type(ESMF_Field) , intent(inout) :: field_dst + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + integer , intent(in) :: maptype + character(len=*), optional, intent(in) :: fldname + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. @@ -1322,19 +1401,31 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (maptype == mapfillv_bilnr) then - call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) + !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=0.0d0, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !if (dbug_flag > 1) then + ! call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if + + !call ESMF_FieldWriteVTK(field_src, 'field_src_'//trim(lfldname), rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + + !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_before', rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapfillv_bilnr), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + !if (dbug_flag > 1) then + ! call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !end if + + !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_after', rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 4c78da123..aa508979a 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -228,8 +228,8 @@ subroutine med_phases_cdeps_run(gcomp, rc) end do ! nflds ! Create empty FB - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBExpIn(n2), rc=rc) .and. found) then - is_local%wrap%FBExpIn(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBData(n2), rc=rc) .and. found) then + is_local%wrap%FBData(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if @@ -271,12 +271,12 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Point FB from internal one - is_local%wrap%FBExpIn(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model + is_local%wrap%FBData(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model ! Write FB for debugging if (dbug_flag > 10) then write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec - call FB_write(is_local%wrap%FBExpIn(n2), suffix, rc) + call FB_write(is_local%wrap%FBData(n2), suffix, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 01d1a52d0..83a8853ec 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -81,6 +81,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compatm), & FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compatm), & field_NormOne=is_local%wrap%field_normOne(compocn,compatm,:), & packed_data=is_local%wrap%packed_data(compocn,compatm,:), & routehandles=is_local%wrap%RH(compocn,compatm,:), rc=rc) From f9ac7af1ae879b6d66a2a95e91e90c55675f3658 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Sun, 12 Nov 2023 01:10:48 -0600 Subject: [PATCH 08/31] more work for cmeps and cdeps inline integration --- mediator/med_map_mod.F90 | 91 ++++++++++++++++++++-------------------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 75dc8189f..e07b0d0c1 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -929,9 +929,12 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle + use ESMF , only : ESMF_FieldFill + use ESMF , only : ESMF_KIND_R8 use med_internalstate_mod , only : nmappers, mapfcopy use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FBSrc @@ -944,23 +947,24 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p integer, optional , intent(out) :: rc ! local variables - integer :: nf, nu, np, n, nfd - integer :: fieldcount, fieldcount_dat - integer :: mapindex - integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr(:) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) - type(ESMF_Field), pointer :: fieldlist_dst(:) - type(ESMF_Field), pointer :: fieldlist_dat(:) - real(r8), pointer :: data_norm(:) - real(r8), pointer :: data_dst(:,:) - character(cl) :: field_name - character(cl), allocatable :: field_namelist_dat(:) - character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' + integer :: nf, nu, np, n, nfd + integer :: fieldcount, fieldcount_dat + integer :: mapindex + integer :: ungriddedUBound(1) + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) + type(ESMF_Field) :: field_fracsrc + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) + type(ESMF_Field), pointer :: fieldlist_dat(:) + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) + character(cl) :: field_name + character(cl), allocatable :: field_namelist_dat(:) + real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1030,6 +1034,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then + ! Fill packed source field call ESMF_FieldGet(fieldlist_src(nf), ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) > 0) then @@ -1070,18 +1075,22 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//" serach for "//trim(field_name) + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for bg fill" ! Check if field has match in data fields do nfd = 1, fieldcount_dat - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd)) if (trim(field_name) == trim(field_namelist_dat(nfd))) then - if (maintask) write(logunit,'(a)') trim(subname)//" filling with background data " + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" ! Get pointer from data field call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before bg fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! Get pointer from destination field and fill it with data if (ungriddedUBound(1) > 0) then call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) @@ -1095,11 +1104,22 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr2d_packed(np,:) = dataptr(:) end if - exit + + if (dbug_flag > 1) then + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after bg fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + exit end if end do end if end do + else + ! Fill packed destination field/s with large value if data is unavailable + ! The data needs to be compated in the component side + call ESMF_FieldFill(packed_data(mapindex)%field_dst, dataFillScheme="const", const1=fillValue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! ----------------------------------- @@ -1335,9 +1355,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : ESMF_KIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_FieldFill use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL use ESMF , only : ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle @@ -1358,7 +1376,6 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname - real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1401,31 +1418,13 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (maptype == mapfillv_bilnr) then - !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) - !call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=0.0d0, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !if (dbug_flag > 1) then - ! call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - - !call ESMF_FieldWriteVTK(field_src, 'field_src_'//trim(lfldname), rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - - !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_before', rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapfillv_bilnr), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - !if (dbug_flag > 1) then - ! call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - !end if - - !call ESMF_FieldWriteVTK(field_dst, 'field_dst_'//trim(lfldname)//'_after', rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call Field_diagnose(field_dst, lfldname, " --> after bilnr: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) From b0af4aad26f0925871987f98b50376c435ccd740 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 15 Nov 2023 13:59:37 -0600 Subject: [PATCH 09/31] add atm->ocn direction for cdeps inline capability --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_map_mod.F90 | 8 +++++--- mediator/med_phases_cdeps_mod.F90 | 9 +++++---- mediator/med_phases_post_atm_mod.F90 | 1 + 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d07923d35..9225fa8dd 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -373,6 +373,7 @@ subroutine med_internalstate_init(gcomp, rc) ! Initialize flag for background fill is_local%wrap%med_bg_fill_active(:,:) = .false. is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. + is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index e07b0d0c1..059677208 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1062,6 +1062,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- + if (maintask) write(logunit,'(a,i)') trim(subname), fieldcount_dat if (fieldcount_dat > 0) then ! First get the pointer for the packed destination data call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) @@ -1075,10 +1076,11 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for bg fill" + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." ! Check if field has match in data fields do nfd = 1, fieldcount_dat + if (maintask) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) if (trim(field_name) == trim(field_namelist_dat(nfd))) then if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" @@ -1087,7 +1089,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before bg fill: ", rc=rc) + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1106,7 +1108,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p end if if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after bg fill: ", rc=rc) + call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index aa508979a..289447201 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -153,6 +153,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Query destination field name and its mesh call ESMF_FieldGet(flddst, mesh=meshdst, name=fldname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//": extracting destination mesh from "//trim(fldname) ! Check if any field in FB in the given stream ! NOTE: Single stream could provide multiple fields !!! @@ -165,11 +166,11 @@ subroutine med_phases_cdeps_run(gcomp, rc) end do end do - ! If match is found, then initialize cdeps inline for the stream - if (streamid /= 0) then + ! If match is found and previously not initialized, then initialize cdeps inline for the stream + if (size(sdat(n1,n2)%stream) == 0 .and. streamid /= 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": "//trim(fldname)//" is found in stream ", streamid + write(logunit,'(a,i)') trim(subname)//": initialize stream ", streamid end if ! Allocate temporary variable to store file names in the stream @@ -179,7 +180,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) ! Fill file abd variable lists with data do l = 1, sdat_config%stream(streamid)%nfiles fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) - if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) end do do l = 1, sdat_config%stream(streamid)%nvars varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 9ed1b78d4..c37749cf2 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -65,6 +65,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compocn), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compocn), & field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & packed_data=is_local%wrap%packed_data(compatm,compocn,:), & routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) From 1296a907239c88bd9bcd6da8cde6cc1d7ecf2089 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 16 Nov 2023 00:18:39 -0600 Subject: [PATCH 10/31] activate cdeps inline capability for atm->wav --- mediator/med_internalstate_mod.F90 | 1 + mediator/med_map_mod.F90 | 1 - mediator/med_phases_post_atm_mod.F90 | 1 + 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 9225fa8dd..bda3d9e21 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -374,6 +374,7 @@ subroutine med_internalstate_init(gcomp, rc) is_local%wrap%med_bg_fill_active(:,:) = .false. is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. + is_local%wrap%med_bg_fill_active(compatm,compwav) = .true. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 059677208..77e15bd2a 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1062,7 +1062,6 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- - if (maintask) write(logunit,'(a,i)') trim(subname), fieldcount_dat if (fieldcount_dat > 0) then ! First get the pointer for the packed destination data call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index c37749cf2..333497a69 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -105,6 +105,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compwav), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & packed_data=is_local%wrap%packed_data(compatm,compwav,:), & routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) From 53bae532ddd2623230cdfea221a0784b80060d35 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Thu, 21 Dec 2023 08:31:50 -0500 Subject: [PATCH 11/31] add flag to track lake freezing for clm lake (#105) * add flag to track lake freezing for clm lake --- ufs/ccpp/data/MED_typedefs.F90 | 4 ++++ ufs/ccpp/data/MED_typedefs.meta | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index e5e1b494f..e7c84506e 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -73,6 +73,7 @@ module MED_typedefs real (kind=kind_phys),pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) logical, pointer :: flag_iter(:) => null() !< flag for iteration + logical, pointer :: flag_lakefreeze(:) => null() !< flag for lake freeze real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) real(kind=kind_phys), pointer :: cmm_water(:) => null() !< momentum exchange coefficient over water (m/s) real(kind=kind_phys), pointer :: chh_water(:) => null() !< thermal exchange coefficient over water (kg/m2s) @@ -368,6 +369,8 @@ subroutine interstitial_create(interstitial, im) interstitial%wind = huge allocate(interstitial%flag_iter(im)) interstitial%flag_iter = .true. + allocate(interstitial%flag_lakefreeze(im)) + interstitial%flag_lakefreeze = .false. allocate(interstitial%qss_water(im)) interstitial%qss_water = huge allocate(interstitial%cmm_ice(im)) @@ -571,6 +574,7 @@ subroutine interstitial_phys_reset(interstitial) interstitial%flag_cice = .false. interstitial%flag_guess = .false. interstitial%flag_iter = .true. + interstitial%flag_lakefreeze = .false. interstitial%fm10_ice = huge interstitial%fm10_land = huge interstitial%fm10_water = huge diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 271110e9c..287739339 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -237,6 +237,12 @@ units = flag dimensions = (horizontal_loop_extent) type = logical +[flag_lakefreeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical [qss_water] standard_name = surface_specific_humidity_over_water long_name = surface air saturation specific humidity over water From cdb819bef6e66287d4ab9e74fb439e8ba3fa05fc Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 28 Dec 2023 16:25:00 -0600 Subject: [PATCH 12/31] feature to use all data in the first coupling timestep --- mediator/med.F90 | 16 +++++++ mediator/med_internalstate_mod.F90 | 29 ++++++----- mediator/med_map_mod.F90 | 72 ++++++++++++++++------------ mediator/med_phases_cdeps_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 35 +++++++++++++- mediator/med_phases_prep_wav_mod.F90 | 33 +++++++++++-- 6 files changed, 138 insertions(+), 49 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 31f67486a..603747fa1 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -950,6 +950,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + ! Should terget component use all data for first time step? + do ncomp = 1,ncomps + if (ncomp /= compmed) then + call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) is_local%wrap%med_data_force_first(ncomp) + else + is_local%wrap%med_data_force_first(ncomp) = .false. + endif + if (maintask) then + write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) + endif + end if + end do + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index bda3d9e21..32b1446bc 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -19,7 +19,7 @@ module med_internalstate_mod integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med main only) - logical, public :: maintask=.false. ! is this the maintask + logical, public :: maintask = .false. ! is this the maintask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 ! Components @@ -119,11 +119,12 @@ module med_internalstate_mod type InternalStateStruct ! Present/allowed coupling/active coupling logical flags - logical, pointer :: comp_present(:) ! comp present flag - logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - logical, pointer :: med_bg_fill_active(:,:) ! use cdeps for background fill - integer :: num_icesheets ! obtained from attribute - logical :: ocn2glc_coupling = .false. ! obtained from attribute + logical, pointer :: comp_present(:) ! comp present flag + logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep + integer :: num_icesheets ! obtained from attribute + logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. @@ -307,7 +308,8 @@ subroutine med_internalstate_init(gcomp, rc) ! Allocate memory now that ncomps is determined allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) - allocate(is_local%wrap%med_bg_fill_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) @@ -370,11 +372,14 @@ subroutine med_internalstate_init(gcomp, rc) write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - ! Initialize flag for background fill - is_local%wrap%med_bg_fill_active(:,:) = .false. - is_local%wrap%med_bg_fill_active(compocn,compatm) = .true. - is_local%wrap%med_bg_fill_active(compatm,compocn) = .true. - is_local%wrap%med_bg_fill_active(compatm,compwav) = .true. + ! Initialize flag for background fill using data + is_local%wrap%med_data_active(:,:) = .false. + is_local%wrap%med_data_active(compocn,compatm) = .true. + is_local%wrap%med_data_active(compatm,compocn) = .true. + is_local%wrap%med_data_active(compatm,compwav) = .true. + + ! Initialize flag to force using data in first coupling time step + is_local%wrap%med_data_force_first(:) = .false. end subroutine med_internalstate_init diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 77e15bd2a..c5d569c62 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -919,7 +919,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end subroutine med_map_packed_field_create !================================================================================ - subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, packed_data, routehandles, rc) + subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -944,6 +944,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + logical, optional , intent(in) :: use_data ! skip mapping and use data instead integer, optional , intent(out) :: rc ! local variables @@ -963,6 +964,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p real(r8), pointer :: data_dst(:,:) character(cl) :: field_name character(cl), allocatable :: field_namelist_dat(:) + logical :: skip_mapping real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- @@ -988,6 +990,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get field count for FBDat if it is given and created fieldcount_dat = 0 + skip_mapping = .false. if (present(FBdat)) then if (ESMF_FieldBundleIsCreated(FBdat)) then call ESMF_FieldBundleGet(FBDat, fieldCount=fieldcount_dat, rc=rc) @@ -997,6 +1000,8 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p allocate(field_namelist_dat(fieldcount_dat)) call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(use_data)) skip_mapping = use_data end if end if @@ -1075,12 +1080,16 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p ! Get size of ungridded dimension and name of the field call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." ! Check if field has match in data fields do nfd = 1, fieldcount_dat - if (maintask) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" ! Get pointer from data field @@ -1088,29 +1097,26 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> before background fill: ", rc=rc) + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! Get pointer from destination field and fill it with data if (ungriddedUBound(1) > 0) then - call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! TODO: Currently assumes same data along the ungridded dimension do nu = 1,ungriddedUBound(1) dataptr2d_packed(np+nu-1,:) = dataptr(:) end do else - call ESMF_FieldGet(fieldlist_dst(nf), farrayptr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr2d_packed(np,:) = dataptr(:) end if if (dbug_flag > 1) then - call Field_diagnose(fieldlist_dst(nf), trim(field_name), " --> after background fill: ", rc=rc) + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Exit from loop since match is already found exit end if end do @@ -1156,31 +1162,35 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, field_normOne, p else if ( trim(packed_data(mapindex)%mapnorm) == 'one' .or. trim(packed_data(mapindex)%mapnorm) == 'none') then - ! Mapping with no normalization that is not redistribution - call med_map_field (& - field_src=packed_data(mapindex)%field_src, & - field_dst=packed_data(mapindex)%field_dst, & - routehandles=routehandles, & - maptype=mapindex, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Obtain unity normalization factor and multiply - ! interpolated field by reciprocal of normalization factor - if (trim(packed_data(mapindex)%mapnorm) == 'one') then - call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + ! Skip mapping if it is requested + if (skip_mapping) then + if (maintask) write(logunit,'(a)') trim(subname)//" skip mapping since use_data is set to .true." + else + ! Mapping with no normalization that is not redistribution + call med_map_field (& + field_src=packed_data(mapindex)%field_src, & + field_dst=packed_data(mapindex)%field_dst, & + routehandles=routehandles, & + maptype=mapindex, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(data_dst,dim=2) - if (data_norm(n) == 0.0_r8) then - data_dst(:,n) = 0.0_r8 - else - data_dst(:,n) = data_dst(:,n)/data_norm(n) - end if - end do - end if + ! Obtain unity normalization factor and multiply + ! interpolated field by reciprocal of normalization factor + if (trim(packed_data(mapindex)%mapnorm) == 'one') then + call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data_dst,dim=2) + if (data_norm(n) == 0.0_r8) then + data_dst(:,n) = 0.0_r8 + else + data_dst(:,n) = data_dst(:,n)/data_norm(n) + end if + end do + end if + end if end if call t_stopf('MED:'//trim(subname)//' map') diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 289447201..7b703e460 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -138,7 +138,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) do n1 = 1, ncomps do n2 = 1, ncomps ! Check for coupling direction and background fill - if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_bg_fill_active(n1,n2)) then + if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_data_active(n1,n2)) then ! Get number of fields call FB_getNumflds(is_local%wrap%FBImp(n1,n2), trim(subname), nflds, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d76f3e81a..6a769bcf1 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -110,12 +110,40 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldList => med_fldList_GetfldListTo(compocn) - ! auto merges to ocn + + !--------------------------------------- + ! --- map atm to ocn, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compocn) .and. & + is_local%wrap%med_data_active(compatm,compocn) .and. & + is_local%wrap%med_data_force_first(compocn)) then + call t_startf('MED:'//trim(subname)//' map_atm2ocn') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compocn), & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compocn), & + use_data=is_local%wrap%med_data_force_first(compocn), & + field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & + packed_data=is_local%wrap%packed_data(compatm,compocn,:), & + routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2ocn') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compocn) = .false. + end if + + !--------------------------------------- + !--- merge all fields to ocn + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -125,6 +153,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + !--- custom calculations + !--------------------------------------- ! compute enthaly associated with rain, snow, condensation and liquid river runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index c690aa522..93755d59c 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav + use med_internalstate_mod , only : compatm, compwav use perf_mod , only : t_startf, t_stopf implicit none @@ -92,12 +92,39 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! auto merges to wav + !--------------------------------------- + ! --- map atm to wav, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compwav) .and. & + is_local%wrap%med_data_active(compatm,compwav) .and. & + is_local%wrap%med_data_force_first(compwav)) then + call t_startf('MED:'//trim(subname)//' map_atm2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & + use_data=is_local%wrap%med_data_force_first(compwav), & + field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & + packed_data=is_local%wrap%packed_data(compatm,compwav,:), & + routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2wav') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compwav) = .false. + end if + + !--------------------------------------- + !--- merge all fields to wav + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & From f8f7ba76ac8b0687695c2a76deaf45ab5c2e39f3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 3 Jan 2024 14:04:07 -0700 Subject: [PATCH 13/31] Changes for physics reorganization (#103) --- ufs/ccpp/config/ccpp_prebuild_config.py | 16 ++++++++-------- ufs/ccpp/data/MED_typedefs.meta | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py index d2872972e..8d8963bad 100755 --- a/ufs/ccpp/config/ccpp_prebuild_config.py +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -25,7 +25,7 @@ VARIABLE_DEFINITION_FILES = [ # actual variable definition files '{}/ccpp/framework/src/ccpp_types.F90'.format(fv3_path), - '{}/ccpp/physics/physics/machine.F'.format(fv3_path), + '{}/ccpp/physics/physics/hooks/machine.F'.format(fv3_path), 'CMEPS/ufs/ccpp/data/MED_typedefs.F90', 'CMEPS/ufs/ccpp/data/MED_data.F90' ] @@ -58,13 +58,13 @@ # Add all physics scheme files relative to basedir SCHEME_FILES = [ - '{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), - '{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), - '{}/ccpp/physics/physics/GFS_surface_loop_control_part1.F90'.format(fv3_path), - '{}/ccpp/physics/physics/GFS_surface_loop_control_part2.F90'.format(fv3_path), - '{}/ccpp/physics/physics/GFS_surface_composites_pre.F90'.format(fv3_path), - '{}/ccpp/physics/physics/GFS_surface_composites_post.F90'.format(fv3_path), - '{}/ccpp/physics/physics/sfc_diag.f'.format(fv3_path) + '{}/ccpp/physics/physics/SFC_Models/Ocean/UFS/sfc_ocean.F'.format(fv3_path), + '{}/ccpp/physics/physics/SFC_Layer/UFS/sfc_diff.f'.format(fv3_path), + '{}/ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90'.format(fv3_path), + '{}/ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90'.format(fv3_path), + '{}/ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90'.format(fv3_path), + '{}/ccpp/physics/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90'.format(fv3_path), + '{}/ccpp/physics/physics/SFC_Layer/UFS/sfc_diag.f'.format(fv3_path) ] # Default build dir, relative to current working directory, diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 287739339..439a617a3 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -1318,7 +1318,7 @@ [ccpp-table-properties] name = MED_typedefs type = module - relative_path = ../../../../../FV3/ccpp/physics/physics + relative_path = ../../../../../FV3/ccpp/physics/physics/hooks dependencies = machine.F,physcons.F90 [ccpp-arg-table] From d56c50c60c29c44103e536d6174dcdfd1759b102 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 5 Jan 2024 15:37:57 -0600 Subject: [PATCH 14/31] fix for gust additions in the aoflux --- mediator/esmFldsExchange_ufs_mod.F90 | 8 -------- mediator/med_phases_aofluxes_mod.F90 | 12 ++++++++---- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index d7367172c..a93a8ff81 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -151,14 +151,6 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) call addfld_ocnalb('So_anidf') end if - ! Advertise the ocean albedos. These are not sent to the ATM in UFS. - if (phase == 'advertise') then - call addfld_ocnalb('So_avsdr') - call addfld_ocnalb('So_avsdf') - call addfld_ocnalb('So_anidr') - call addfld_ocnalb('So_anidf') - end if - !===================================================================== ! FIELDS TO ATMOSPHERE (compatm) !===================================================================== diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index cc62bbd36..1d8efe7e8 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1597,8 +1597,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! extra fields for ufs.frac.aoflux @@ -1710,8 +1708,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_tauy', aoflux_out%tauy, xgrid=xgrid, rc=rc) @@ -1724,6 +1720,7 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1737,6 +1734,13 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if + if (add_gusts) then + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + end if + end subroutine set_aoflux_out_pointers !================================================================================ From 55c890048db8aa1a7641adf0f7c9bfc2accd0ac1 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 15 Jan 2024 01:52:06 -0600 Subject: [PATCH 15/31] mods for regional mom6 configuration --- mediator/esmFldsExchange_hafs_mod.F90 | 361 +++++++++++++++++--------- mediator/med.F90 | 2 +- mediator/med_internalstate_mod.F90 | 2 +- mediator/med_map_mod.F90 | 2 +- 4 files changed, 243 insertions(+), 124 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 1f645524e..4aa02a7b8 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -13,6 +13,7 @@ module esmFldsExchange_hafs_mod use med_internalstate_mod , only : compwav use med_internalstate_mod , only : ncomps use med_internalstate_mod , only : coupling_mode + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -133,7 +134,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !===================================================================== - ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + ! Mediator fields !===================================================================== !---------------------------------------------------------- @@ -146,6 +147,16 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- call addfld_to(compatm, 'So_ofrac') + !---------------------------------------------------------- + ! from med: ocean albedos (not sent to the ATM in UFS). + !---------------------------------------------------------- + if (phase == 'advertise') then + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') + end if + !===================================================================== ! FIELDS TO ATMOSPHERE !===================================================================== @@ -154,28 +165,41 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to atm: surface temperatures from ocn ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compocn, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compwav, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compwav, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) end if !===================================================================== @@ -186,40 +210,72 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compocn, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - call addfld_from(compatm, trim(fldname1)) - call addfld_to(compocn, trim(fldname2)) - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + end if end if !===================================================================== @@ -230,14 +286,14 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to wav: 10-m wind components ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(2)) - S_flds = (/'Sa_u10m', 'Sa_v10m'/) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compwav, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compwav, trim(fldname)) + end do + deallocate(S_flds) end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -356,40 +412,59 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to atm: sea surface temperature ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & - ) then - call addmap_from(compocn, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & - ) then - call addmap_from(compwav, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & + ) then + call addmap_from(compwav, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) end if !===================================================================== @@ -400,52 +475,96 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname1), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname2), & - mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') - end if - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + end if end if !===================================================================== diff --git a/mediator/med.F90 b/mediator/med.F90 index 88245dedb..0cc9ee317 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1837,7 +1837,7 @@ subroutine DataInitialize(gcomp, rc) else if (trim(coupling_mode(1:3)) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'hafs') then + else if (trim(coupling_mode(1:4)) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c269608cc..b06f20c1c 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -47,7 +47,7 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6] ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2e2d38197..fc7e1565d 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -414,7 +414,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask end if end if - if (trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode(1:4)) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if From 6979bbdadcebd97cb630d22e2f989c020c348682 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 17 Jan 2024 16:45:16 -0600 Subject: [PATCH 16/31] fix for sw bands calculation for cases without sea-ice --- mediator/med_phases_prep_ocn_mod.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 6a769bcf1..d911d93e1 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -469,11 +469,18 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end do ! Compute sw export to ocean bands if required if (export_swnet_by_bands) then - c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 - Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) - Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) - Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) - Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) + if (trim(coupling_mode) == 'cesm') then + c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 + Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) + Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) + Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) + Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) + else + Foxx_swnet_vdr(:) = Faxa_swvdr(:) * (1.0_R8 - avsdr(:)) + Foxx_swnet_vdf(:) = Faxa_swvdf(:) * (1.0_R8 - avsdf(:)) + Foxx_swnet_idr(:) = Faxa_swndr(:) * (1.0_R8 - anidr(:)) + Foxx_swnet_idf(:) = Faxa_swndf(:) * (1.0_R8 - anidf(:)) + end if end if end if From 10e46c3ad443aae605a683f0461391cb68e32bfa Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Thu, 18 Jan 2024 22:49:13 -0600 Subject: [PATCH 17/31] more work for regional mom6 coupling --- mediator/esmFldsExchange_hafs_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 4aa02a7b8..635e51b04 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -263,7 +263,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx - F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx @@ -546,7 +546,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx - F_flds(6 ,:) = (/'Faxa_lat ','Foxx_evap '/) ! mean_laten_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx From ad1e9a2ecbb6a240b8326ee36efd76a070aee4ae Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 19 Jan 2024 17:01:49 -0600 Subject: [PATCH 18/31] update for hafs.mom6 --- mediator/esmFldsExchange_hafs_mod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 635e51b04..5800516f9 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -150,11 +150,13 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- ! from med: ocean albedos (not sent to the ATM in UFS). !---------------------------------------------------------- - if (phase == 'advertise') then - call addfld_ocnalb('So_avsdr') - call addfld_ocnalb('So_avsdf') - call addfld_ocnalb('So_anidr') - call addfld_ocnalb('So_anidf') + if (trim(coupling_mode) == 'hafs.mom6') then + if (phase == 'advertise') then + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') + end if end if !===================================================================== From a1cbcbcb0189c49cdd3336b4f7c24b6e0b6aa0dc Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 19 Jan 2024 18:01:10 -0600 Subject: [PATCH 19/31] switch TOTAL to SELECT for other interpolation types too --- mediator/med_map_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index fc7e1565d..4331cfd97 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1367,7 +1367,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag use ESMF , only : ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle use ESMF , only : ESMF_FieldWriteVTK @@ -1400,7 +1400,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (maptype == mapnstod_consd) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1415,7 +1415,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else if (maptype == mapnstod_consf) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1438,7 +1438,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From fb993eb4b6a67859aa50e7a420517bfeb7713c92 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 25 Jan 2024 10:58:54 -0700 Subject: [PATCH 20/31] fix from Denise for crash when diagnose is on by initializing --- mediator/med_map_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 4331cfd97..48215333c 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -893,12 +893,14 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & if (npacked(mapindex) > 0) then ! Create the packed source field bundle for mapindex allocate(ptrsrc_packed(npacked(mapindex), lsize_src)) + ptrsrc_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_src = ESMF_FieldCreate(lmesh_src, & ptrsrc_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create the packed destination field bundle for mapindex allocate(ptrdst_packed(npacked(mapindex), lsize_dst)) + ptrdst_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_dst = ESMF_FieldCreate(lmesh_dst, & ptrdst_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 13ed05982efc95c077efc3b9609688554e3a854c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ufuk=20Turun=C3=A7o=C4=9Flu?= Date: Fri, 26 Jan 2024 07:11:40 -0700 Subject: [PATCH 21/31] Updates for component land model (#98) --- cesm/driver/ensemble_driver.F90 | 4 +- cesm/driver/esm.F90 | 1 + cesm/driver/esm_time_mod.F90 | 1 - mediator/esmFldsExchange_ufs_mod.F90 | 62 ++- mediator/med.F90 | 3 - mediator/med_map_mod.F90 | 1 + ufs/ufs_io_mod.F90 | 679 ++++++++++++++------------- 7 files changed, 397 insertions(+), 354 deletions(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 2656f10fc..5ca17b1b4 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -145,7 +145,7 @@ subroutine SetModelServices(ensemble_driver, rc) integer :: pio_asyncio_stride integer :: pio_asyncio_rootpe integer :: Global_Comm - character(len=CL) :: start_type ! Type of startup + character(len=CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix character(len=CX) :: msgstr @@ -377,10 +377,8 @@ subroutine SetModelServices(ensemble_driver, rc) endif call shr_log_setLogUnit (logunit) ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, localpet==petList(1), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955a..759a4e986 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1517,6 +1517,7 @@ subroutine esm_finalize(driver, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS + call shr_log_setLogunit(logunit) call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index fc57eaf11..3b56bb953 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -282,7 +282,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/esmFldsExchange_ufs_mod.F90 b/mediator/esmFldsExchange_ufs_mod.F90 index a93a8ff81..aa8088306 100644 --- a/mediator/esmFldsExchange_ufs_mod.F90 +++ b/mediator/esmFldsExchange_ufs_mod.F90 @@ -234,18 +234,46 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) end if end if - ! to atm: unmerged surface temperatures from lnd - if (phase == 'advertise') then - if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(complnd , 'Sl_t') - call addfld_to(compatm , 'Sl_t') + ! to atm: unmerged flux components from lnd + if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then + allocate(flds(6)) + flds = (/ 'lat ', 'sen ', 'evap', 'gflx', 'roff', 'soff' /) + if (phase == 'advertise') then + do n = 1,size(flds) + call addfld_from(complnd, 'Fall_'//trim(flds(n))) + call addfld_to(compatm, 'Fall_'//trim(flds(n))) + end do + else + do n = 1,size(flds) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Fall_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(flds(n)), rc=rc)) then + call addmap_from(complnd, 'Fall_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset') + call addmrg_to(compatm, 'Fall_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Fall_'//trim(flds(n)), mrg_type='copy') + end if + end do end if - else - if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then - call addmap_from(complnd, 'Sl_t', compatm, maptype, 'lfrin', 'unset') - call addmrg_to(compatm, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') + deallocate(flds) + end if + + ! to atm: unmerged state variables from lnd + if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then + allocate(flds(7)) + flds = (/ 'sfrac', 'tref ', 'qref ', 'q ', 'cmm ', 'chh ', 'zvfun' /) + if (phase == 'advertise') then + do n = 1,size(flds) + call addfld_from(complnd, 'Sl_'//trim(flds(n))) + call addfld_to(compatm, 'Sl_'//trim(flds(n))) + end do + else + do n = 1,size(flds) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_'//trim(flds(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(flds(n)), rc=rc)) then + call addmap_from(complnd, 'Sl_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset') + call addmrg_to(compatm, 'Sl_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Sl_'//trim(flds(n)), mrg_type='copy') + end if + end do end if + deallocate(flds) end if ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step @@ -716,18 +744,16 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc) if ( trim(coupling_mode) == 'ufs.nfrac.aoflux') then allocate(flds(21)) flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & - 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & - 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Sa_pslv ', & - 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & - 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', & - 'Faxa_swnet'/) + 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Sa_pslv ', & + 'Faxa_lwdn ', 'Faxa_swdn ', 'Faxa_snowc', 'Faxa_snowl', & + 'Faxa_rainc', 'Faxa_rainl', 'Faxa_rain ', 'Faxa_swnet'/) else allocate(flds(18)) flds = (/'Sa_z ', 'Sa_ta ', 'Sa_pslv ', 'Sa_qa ', & - 'Sa_ua ', 'Sa_va ', 'Faxa_swdn ', 'Faxa_lwdn ', & - 'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl ', 'vfrac ', & + 'Sa_u ', 'Sa_v ', 'Faxa_swdn ', 'Faxa_lwdn ', & + 'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl ', 'Sa_vfrac ', & 'Faxa_snow ', 'Faxa_rainc', 'Sa_tskn ', 'Sa_exner ', & - 'Sa_ustar ', 'zorl ' /) + 'Sa_ustar ', 'Sa_zorl ' /) end if do n = 1,size(flds) fldname = trim(flds(n)) diff --git a/mediator/med.F90 b/mediator/med.F90 index 98021c647..87bbb2fac 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1023,7 +1023,6 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local integer :: n1 character(len=*), parameter :: subname = '('//__FILE__//':ModifyDecompofMesh)' - !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1352,7 +1351,6 @@ subroutine RealizeFieldsWithTransferAccept(gcomp, importState, exportState, cloc type(InternalState) :: is_local integer :: n1 character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferAccept)' - !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2222,7 +2220,6 @@ subroutine SetRunClock(gcomp, rc) integer :: stop_n, stop_ymd logical, save :: stopalarmcreated=.false. character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' - !----------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 0df18a770..3428d2268 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1049,6 +1049,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d trim(packed_data(mapindex)%mapnorm) /= 'none') then ! Normalized mapping - assume that each packed field has only one normalization type + call ESMF_LogWrite(trim(subname)//": FB get "//trim(packed_data(mapindex)%mapnorm), ESMF_LOGMSG_INFO) call ESMF_FieldBundleGet(FBFracSrc, packed_data(mapindex)%mapnorm, field=field_fracsrc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_map_field_normalized(& diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index 8564be8e5..d89a6f014 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -22,21 +22,14 @@ module ufs_io_mod use ESMF, only : ESMF_FieldWrite, ESMF_FieldBundleRead, ESMF_FieldBundleWrite use ESMF, only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_MeshCreate use ESMF, only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL + use ESMF, only : ESMF_RouteHandle, ESMF_FieldBundleRedistStore + use ESMF, only : ESMF_FieldBundleRedist, ESMF_RouteHandleDestroy + use ESMF, only : ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R4 use NUOPC, only : NUOPC_CompAttributeGet use NUOPC_Mediator, only : NUOPC_MediatorGet - use fms_mod, only : fms_init - use fms2_io_mod, only : open_file, FmsNetcdfFile_t - use mosaic2_mod, only : get_mosaic_ntiles, get_mosaic_grid_sizes - use mosaic2_mod, only : get_mosaic_contact, get_mosaic_ncontacts - use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL - use mpp_domains_mod, only : mpp_define_layout, mpp_get_compute_domain - use mpp_domains_mod, only : mpp_domains_init, mpp_define_mosaic, domain2d - use mpp_io_mod, only : MPP_RDONLY, MPP_NETCDF, MPP_SINGLE, MPP_MULTI - use mpp_io_mod, only : mpp_get_info, mpp_get_fields, mpp_get_atts - use mpp_io_mod, only : mpp_open, mpp_read, fieldtype - - use med_kind_mod, only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use med_kind_mod, only : r4=>SHR_KIND_R4, r8=>SHR_KIND_R8 + use med_kind_mod, only : cs=>SHR_KIND_CS, cl=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_constants_mod, only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod, only : InternalState, maintask, logunit @@ -62,24 +55,25 @@ module ufs_io_mod type(ESMF_Grid) :: grid ! ESMF grid object from mosaic file type(ESMF_Mesh) :: mesh ! ESMF mesh object from CS grid type(ESMF_RouteHandle) :: rh ! ESMF routehandle object to redist data from CS grid to mesh - type(domain2d) :: mosaic_domain ! domain object created by FMS integer :: layout(2) ! layout for domain decomposition - integer, allocatable :: nit(:) ! size of tile in i direction - integer, allocatable :: njt(:) ! size of tile in j direction integer :: ntiles ! number of tiles in case of having CS grid - integer :: ncontacts ! number of contacts in case of having CS grid - integer, allocatable :: tile1(:) ! list of tile numbers in tile 1 of each contact - integer, allocatable :: tile2(:) ! list of tile numbers in tile 2 of each contact - integer, allocatable :: istart1(:) ! list of starting i-index in tile 1 of each contact - integer, allocatable :: iend1(:) ! list of ending i-index in tile 1 of each contact - integer, allocatable :: jstart1(:) ! list of starting j-index in tile 1 of each contact - integer, allocatable :: jend1(:) ! list of ending j-index in tile 1 of each contact - integer, allocatable :: istart2(:) ! list of starting i-index in tile 2 of each contact - integer, allocatable :: iend2(:) ! list of ending i-index in tile 2 of each contact - integer, allocatable :: jstart2(:) ! list of starting j-index in tile 2 of each contact - integer, allocatable :: jend2(:) ! list of ending j-index in tile 2 of each contact end type domain_type + type field_type + real(r4), pointer :: ptr1r4(:) ! data pointer for 1d r4 + real(r8), pointer :: ptr1r8(:) ! data pointer for 1d r8 + integer , pointer :: ptr1i4(:) ! data pointer for 1d i4 + real(r4), pointer :: ptr2r4(:,:) ! data pointer for 2d r4 + real(r8), pointer :: ptr2r8(:,:) ! data pointer for 2d r8 + integer , pointer :: ptr2i4(:,:) ! data pointer for 2d i4 + character(len=128) :: short_name = "" ! variable short name + character(len=128) :: units = "" ! variable unit + character(len=128) :: long_name = "" ! variable long name + character(len=128) :: zaxis = "" ! name of z-axis + integer :: nlev ! number of layers in z-axis + integer :: nrec ! number of record in file (time axis) + end type field_type + character(cl) :: case_name = 'unset' ! case name character(*), parameter :: modName = "(ufs_io_mod)" @@ -106,10 +100,11 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) type(domain_type) :: domain type(InternalState) :: is_local type(ESMF_RouteHandle) :: rh - type(ESMF_Field) :: lfield, field, field_dst - real(ESMF_KIND_R8), pointer :: ptr(:) + type(ESMF_Field) :: field_src, field_dst + real(ESMF_KIND_R8), pointer :: ptr_src(:), ptr_dst(:) integer :: n - character(len=cs), allocatable :: flds(:) + character(len=cs) :: flds_name(2) + type(field_type) :: flds(1) character(len=*), parameter :: subname = trim(modName)//': (read_initial) ' !------------------------------------------------------------------------------- @@ -121,10 +116,14 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! --------------------- - ! Create domain + ! Set domain specific parameters + ! TODO: This assumes global domain with six tile and needs to be + ! revisited to support regional apps with one tile ! --------------------- - call create_fms_domain(gcomp, domain, mosaic_file, layout, rc) + domain%ntiles = 6 + domain%layout(1) = layout(1) + domain%layout(2) = layout(2) ! --------------------- ! Create grid @@ -132,59 +131,88 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) call create_grid(gcomp, domain, mosaic_file, input_dir, rc) + ! --------------------- + ! Create field in source mesh + ! --------------------- + + ! create field + field_src = ESMF_FieldCreate(domain%mesh, ESMF_TYPEKIND_R8, name='field_src', & + meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and init it + call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr_src(:) = 0.0_r8 + + ! --------------------- + ! Create field in destination mesh + ! --------------------- + + ! create destination field + field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name='field_dst', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and init it + call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr_src(:) = 0.0_r8 + + ! --------------------- + ! Create routehandle + ! --------------------- + + call ESMF_FieldRegridStore(field_src, field_dst, routehandle=rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !---------------------- ! Read data !---------------------- - allocate(flds(2)) - flds = (/ 'zorl ', & - 'uustar' /) - do n = 1,size(flds) - ! read from tiled file - call read_tiled_file(gcomp, ini_file, trim(flds(n)), domain, field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create destination field - field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & - name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! list of fields that need to be read + flds_name(1) = 'zorl' + flds_name(2) = 'uustar' - ! create rh - call ESMF_FieldRegridStore(field, field_dst, routehandle=rh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! loop over fields and read them + do n = 1,size(flds) + ! read data + flds(1)%short_name = trim(flds_name(n)) + flds(1)%ptr1r8 => ptr_src + call read_tiled_file(domain, ini_file, flds, rc=rc) ! map field if (is_local%wrap%aoflux_grid == 'agrid') then - ! do nothing, just redist in case of haning different decomp. in here and aoflux mesh - call ESMF_FieldRedist(field, field_dst, rh, rc=rc) + ! do nothing, just redist in case of having different decomp. in here and aoflux mesh + call ESMF_FieldRedist(field_src, field_dst, rh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! remap from atm to ocn or exchange grid - call ESMF_FieldRegrid(field, field_dst, rh, termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + call ESMF_FieldRegrid(field_src, field_dst, rh, termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! debug if (dbug_flag > 5) then - call ESMF_FieldWriteVTK(field_dst, 'ini_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) + call ESMF_FieldWriteVTK(field_dst, 'ini_'//trim(flds_name(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! return pointer and fill variable - call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) - if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) - if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) - nullify(ptr) - - ! free memory - call ESMF_FieldDestroy(field_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! fill variables + if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds_name(n)) + if (trim(flds_name(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr_dst(:) + if (trim(flds_name(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr_dst(:) end do - ! free memory - if (allocated(flds)) deallocate(flds) + !---------------------- + ! Free memory + !---------------------- + + call ESMF_FieldDestroy(field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldDestroy(field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -333,181 +361,6 @@ subroutine read_restart(gcomp, rst_file, rc) end subroutine read_restart - !=============================================================================== - subroutine create_fms_domain(gcomp, domain, mosaic_file, layout, rc) - implicit none - - ! input/output variables - type(ESMF_GridComp), intent(in) :: gcomp - type(domain_type), intent(inout) :: domain - character(len=cl), intent(in) :: mosaic_file - integer :: layout(2) - integer, intent(inout) :: rc - - ! local variables - type(ESMF_VM) :: vm - type(FmsNetcdfFile_t) :: mosaic_fileobj - integer :: mpicomm, npes_per_tile - integer :: n, ntiles, npet - integer :: halo = 0 - integer :: global_indices(4,6) - integer :: layout2d(2,6) - integer, allocatable :: pe_start(:), pe_end(:) - character(len=cl) :: msg - character(len=*), parameter :: subname = trim(modName)//': (create_fms_domain) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - - ! --------------------- - ! Initialize FMS - ! --------------------- - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm=vm, mpiCommunicator=mpicomm, petCount=npet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call fms_init(mpicomm) - - ! --------------------- - ! Open mosaic file and query some information - ! --------------------- - - if (.not. open_file(mosaic_fileobj, trim(mosaic_file), 'read')) then - call ESMF_LogWrite(trim(subname)//'error in opening file '//trim(mosaic_file), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - ! query number of tiles - domain%ntiles = get_mosaic_ntiles(mosaic_fileobj) - - ! query domain sizes for each tile - if (.not. allocated(domain%nit)) allocate(domain%nit(domain%ntiles)) - if (.not. allocated(domain%njt)) allocate(domain%njt(domain%ntiles)) - call get_mosaic_grid_sizes(mosaic_fileobj, domain%nit, domain%njt) - - ! query number of contacts - domain%ncontacts = get_mosaic_ncontacts(mosaic_fileobj) - - ! allocate required arrays to create FMS domain from mosaic file - if (.not. allocated(domain%tile1)) allocate(domain%tile1(domain%ncontacts)) - if (.not. allocated(domain%tile2)) allocate(domain%tile2(domain%ncontacts)) - if (.not. allocated(domain%istart1)) allocate(domain%istart1(domain%ncontacts)) - if (.not. allocated(domain%iend1)) allocate(domain%iend1(domain%ncontacts)) - if (.not. allocated(domain%jstart1)) allocate(domain%jstart1(domain%ncontacts)) - if (.not. allocated(domain%jend1)) allocate(domain%jend1(domain%ncontacts)) - if (.not. allocated(domain%istart2)) allocate(domain%istart2(domain%ncontacts)) - if (.not. allocated(domain%iend2)) allocate(domain%iend2(domain%ncontacts)) - if (.not. allocated(domain%jstart2)) allocate(domain%jstart2(domain%ncontacts)) - if (.not. allocated(domain%jend2)) allocate(domain%jend2(domain%ncontacts)) - - ! query information about contacts - call get_mosaic_contact(mosaic_fileobj, domain%tile1, domain%tile2, & - domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & - domain%istart2, domain%iend2, domain%jstart2, domain%jend2) - - ! print out debug information - if (dbug_flag > 2) then - do n = 1, domain%ncontacts - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' : tile1, tile2 (', n ,') = ', domain%tile1(n), domain%tile2(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart1, iend1, jstart1, jend1 (', n ,') = ', & - domain%istart1(n), domain%iend1(n), domain%jstart1(n), domain%jend1(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart2, iend2, jstart2, jend2 (', n ,') = ', & - domain%istart2(n), domain%iend2(n), domain%jstart2(n), domain%jend2(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end do - end if - - !---------------------- - ! Initialize domain - !---------------------- - - call mpp_domains_init() - - !---------------------- - ! Find out layout that will be used to read the data - !---------------------- - - ! setup global indices - do n = 1, domain%ntiles - global_indices(1,n) = 1 - global_indices(2,n) = domain%nit(n) - global_indices(3,n) = 1 - global_indices(4,n) = domain%njt(n) - end do - - ! check total number of PETs - if (mod(npet, domain%ntiles) /= 0) then - write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - ! calculate layout if it is not provided as configuration option - if (layout(1) < 0 .and. layout(2) < 0) then - npes_per_tile = npet/domain%ntiles - call mpp_define_layout(global_indices(:,1), npes_per_tile, domain%layout) - else - domain%layout(:) = layout(:) - end if - - ! set layout and print out debug information - do n = 1, domain%ntiles - layout2d(:,n) = domain%layout(:) - if (dbug_flag > 2) then - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' layout (', n ,') = ', layout2d(1,n), layout2d(2,n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' global_indices (', n,') = ', & - global_indices(1,n), global_indices(2,n), global_indices(3,n), global_indices(4,n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end if - enddo - - !---------------------- - ! Set pe_start, pe_end - !---------------------- - - allocate(pe_start(domain%ntiles)) - allocate(pe_end(domain%ntiles)) - do n = 1, domain%ntiles - pe_start(n) = mpp_root_pe()+(n-1)*domain%layout(1)*domain%layout(2) - pe_end(n) = mpp_root_pe()+n*domain%layout(1)*domain%layout(2)-1 - if (dbug_flag > 2) then - write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' pe_start, pe_end (', n ,') = ', pe_start(n), pe_end(n) - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - end if - enddo - - !---------------------- - ! Create FMS domain object - !---------------------- - - call mpp_define_mosaic(global_indices, layout2d, domain%mosaic_domain, & - domain%ntiles, domain%ncontacts, domain%tile1, domain%tile2, & - domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & - domain%istart2, domain%iend2, domain%jstart2, domain%jend2, & - pe_start, pe_end, symmetry=.true., & - whalo=halo, ehalo=halo, shalo=halo, nhalo=halo, & - name='atm domain') - - !---------------------- - ! Deallocate temporary arrays - !---------------------- - - deallocate(pe_start) - deallocate(pe_end) - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - - end subroutine create_fms_domain - !=============================================================================== subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) implicit none @@ -553,148 +406,316 @@ subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) end subroutine create_grid !=============================================================================== - subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, rc) - implicit none + subroutine read_tiled_file(domain, filename, flds, rh, rc) ! input/output variables - type(ESMF_GridComp), intent(in) :: gcomp - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - type(domain_type), intent(inout) :: domain - type(ESMF_Field), intent(inout) :: field_dst - integer, intent(inout), optional :: rc + type(domain_type), intent(inout) :: domain + character(len=*), intent(in) :: filename + type(field_type), intent(in) :: flds(:) + type(ESMF_RouteHandle), optional, intent(in) :: rh + integer, optional, intent(inout) :: rc ! local variables - type(ESMF_Field) :: field_src, field_tmp + integer :: i, j, k, rank, fieldCount + integer, pointer :: ptr_i4(:) + real(r4), pointer :: ptr_r4(:) + real(r8), pointer :: ptr_r8(:) + type(ESMF_RouteHandle) :: rh_local + type(ESMF_FieldBundle) :: FBgrid, FBmesh type(ESMF_ArraySpec) :: arraySpec - type(InternalState) :: is_local - type(fieldtype), allocatable:: vars(:) - integer :: funit, my_tile - integer :: i, j, n - integer :: isc, iec, jsc, jec - integer :: ndim, nvar, natt, ntime - logical :: not_found, is_root_pe - real(ESMF_KIND_R8), pointer :: ptr2d(:,:) - real(r8), allocatable :: rdata(:,:) - character(len=cl) :: cname - character(len=*), parameter :: subname=trim(modName)//': (read_tiled_file) ' + type(ESMF_Field) :: fgrid, fmesh, ftmp + character(len=cl) :: fname + character(len=cl), allocatable :: fieldNameList(:) + character(len=*), parameter :: subname = trim(modName)//': (read_tiled_file) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' reading '//trim(varname), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//' called for '//trim(filename), ESMF_LOGMSG_INFO) !---------------------- - ! Get the internal state from the mediator component + ! Create field bundles !---------------------- - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! create empty field bundle on grid + FBgrid = ESMF_FieldBundleCreate(name="fields_on_grid", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create empty field bundle on mesh + FBmesh = ESMF_FieldBundleCreate(name="fields_on_mesh", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Set tile + ! Loop over fields and add them to the field bundles !---------------------- - my_tile = int(mpp_pe()/(domain%layout(1)*domain%layout(2)))+1 - is_root_pe = .false. - if (mpp_pe() == (my_tile-1)*(domain%layout(1)*domain%layout(2))) is_root_pe = .true. + do i = 1, size(flds) + ! 2d/r8 field (x,y) + if (associated(flds(i)%ptr1r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr1r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/r4 field (x,y) + else if (associated(flds(i)%ptr1r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr1r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 2d/i4 field (x,y) + else if (associated(flds(i)%ptr1i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_I4, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr1i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r8 field (x,y,rec) + else if (associated(flds(i)%ptr2r8)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr2r8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/r4 field (x,y,rec) + else if (associated(flds(i)%ptr2r4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr2r4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 3d/i4 field (x,y,rec) + else if (associated(flds(i)%ptr2i4)) then + ! set field type + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_I4, rank=3, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on grid + fgrid = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(flds(i)%short_name), ungriddedLbound=(/1/), & + ungriddedUbound=(/flds(i)%nrec/), gridToFieldMap=(/1,2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create field on mesh + fmesh = ESMF_FieldCreate(domain%mesh, flds(i)%ptr2i4, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(flds(i)%short_name), gridToFieldMap=(/1/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! debug print + call ESMF_LogWrite(trim(subname)//' adding '//trim(flds(i)%short_name)//' to FB', ESMF_LOGMSG_INFO) + + ! add it to the field bundle on grid + call ESMF_FieldBundleAdd(FBgrid, [fgrid], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add it to the field bundle on mesh + call ESMF_FieldBundleAdd(FBmesh, [fmesh], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do !---------------------- - ! Open file and query file attributes + ! Read data !---------------------- - - write(cname, fmt='(A,I1,A)') trim(filename), my_tile, '.nc' - call mpp_open(funit, trim(cname), action=MPP_RDONLY, form=MPP_NETCDF, threading=MPP_MULTI, fileset=MPP_SINGLE, is_root_pe=is_root_pe) - call mpp_get_info(funit, ndim, nvar, natt, ntime) - allocate(vars(nvar)) - call mpp_get_fields(funit, vars(:)) + + call ESMF_FieldBundleRead(FBgrid, fileName=trim(filename), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Find and read requested variable + ! Create routehandle if it is not provided to transfer data from grid to mesh !---------------------- - not_found = .true. - do n = 1, nvar - ! get variable name - call mpp_get_atts(vars(n), name=cname) + if (present(rh)) then + rh_local = rh + else + call ESMF_FieldBundleRedistStore(FBgrid, FBmesh, routehandle=rh_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! check variable name - if (trim(cname) == trim(varname)) then - ! get array bounds or domain - call mpp_get_compute_domain(domain%mosaic_domain, isc, iec, jsc, jec) + !---------------------- + ! Move data from ESMF grid to mesh + !---------------------- - ! allocate data array and set initial value - allocate(rdata(isc:iec,jsc:jec)) - rdata(:,:) = 0.0_r8 + call ESMF_FieldBundleRedist(FBgrid, FBmesh, rh_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! read data - call mpp_read(funit, vars(n), domain%mosaic_domain, rdata, 1) + !---------------------- + ! Debug output + !---------------------- - ! set missing values to zero - where (rdata == 1.0e20) - rdata(:,:) = 0.0_r8 - end where - end if + if (dbug_flag > 5) then + do i = 1, size(flds) + ! get field from FB + call ESMF_FieldBundleGet(FBmesh, fieldName=trim(flds(i)%short_name), field=fmesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - not_found = .false. - end do + ! check its rank + call ESMF_FieldGet(fmesh, rank=rank, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (not_found) then - call mpp_error(FATAL, 'File being read is not the expected one. '//trim(varname)//' is not found.') + ! TODO: ESMF_FieldWriteVTK() call does not support ungridded dimension + ! The workaround is implemented in here but it would be nice to extend + ! ESMF_FieldWriteVTK() call to handle it. + if (rank > 1) then + ! create temporary field + if (associated(flds(i)%ptr2r4)) then + ftmp = ESMF_FieldCreate(domain%mesh, typekind=ESMF_TYPEKIND_R4, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr_r4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (associated(flds(i)%ptr2r8)) then + ftmp = ESMF_FieldCreate(domain%mesh, typekind=ESMF_TYPEKIND_R8, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr_r8, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (associated(flds(i)%ptr2i4)) then + ftmp = ESMF_FieldCreate(domain%mesh, typekind=ESMF_TYPEKIND_I4, & + name=trim(flds(i)%short_name), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(ftmp, localDe=0, farrayPtr=ptr_i4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! write all record to seperate VTK file + do j = 1, flds(i)%nrec + if (associated(flds(i)%ptr2i4)) ptr_i4(:) = flds(i)%ptr2i4(:,j) + if (associated(flds(i)%ptr2r4)) ptr_r4(:) = flds(i)%ptr2r4(:,j) + if (associated(flds(i)%ptr2r8)) ptr_r8(:) = flds(i)%ptr2r8(:,j) + write(fname, fmt='(A,I2.2)') trim(flds(i)%short_name)//'_rec', j + call ESMF_FieldWriteVTK(ftmp, trim(fname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! delete temporary field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! write field to VTK file + call ESMF_FieldWriteVTK(fmesh, trim(flds(i)%short_name), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do end if !---------------------- - ! Move data from grid to mesh + ! Empty FBs and destroy them !---------------------- - ! set type and rank for ESMF arrayspec - call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + ! FB grid + call ESMF_FieldBundleGet(FBgrid, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create source field - field_src = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & - indexflag=ESMF_INDEX_GLOBAL, name=trim(varname), rc=rc) + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBgrid, fieldNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get pointer and fill it - call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr2d, rc=rc) + do i = 1, fieldCount + ! pull field from FB + call ESMF_FieldBundleGet(FBgrid, fieldName=trim(fieldNameList(i)), field=ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! destroy field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! remove field from FB + call ESMF_FieldBundleRemove(FBgrid, fieldNameList=[trim(fieldNameList(i))], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) + + ! destroy grid FB + call ESMF_FieldBundleDestroy(FBgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ptr2d(:,:) = rdata(:,:) - nullify(ptr2d) - if (allocated(rdata)) deallocate(rdata) - ! create destination field - field_dst = ESMF_FieldCreate(domain%mesh, ESMF_TYPEKIND_R8, name=trim(varname), & - meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + ! FB mesh + call ESMF_FieldBundleGet(FBmesh, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBmesh, fieldNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create routehandle from grid to mesh - if (.not. ESMF_RouteHandleIsCreated(domain%rh, rc=rc)) then - call ESMF_FieldRegridStore(field_src, field_dst, routehandle=domain%rh, rc=rc) + do i = 1, fieldCount + ! pull field from FB + call ESMF_FieldBundleGet(FBmesh, fieldName=trim(fieldNameList(i)), field=ftmp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! redist field from ESMF Grid to Mesh - call ESMF_FieldRedist(field_src, field_dst, domain%rh, rc=rc) + ! destroy field + call ESMF_FieldDestroy(ftmp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! remove field from FB + call ESMF_FieldBundleRemove(FBmesh, fieldNameList=[trim(fieldNameList(i))], rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) + + ! destroy grid FB + call ESMF_FieldBundleDestroy(FBmesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- - ! Output result field for debugging purpose + ! Destroy route handle if it is created locally !---------------------- - if (dbug_flag > 2) then - call ESMF_FieldWrite(field_dst, trim(varname)//'_agrid.nc', variableName=trim(varname), overwrite=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - if (dbug_flag > 5) then - call ESMF_FieldWriteVTK(field_dst, trim(varname)//'_agrid', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. present(rh)) then + call ESMF_RouteHandleDestroy(rh_local, rc=rc) end if - ! clean memory - call ESMF_FieldDestroy(field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine read_tiled_file From 8c10846bbdcd6417e660c73ae6fc11c2e5559e63 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sat, 27 Jan 2024 14:38:42 -0700 Subject: [PATCH 22/31] fix issue arised in CESM testing --- mediator/med_map_mod.F90 | 39 +++++++++++++++++++++++++++------------ 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 48215333c..8ba343f4e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -933,6 +933,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle use ESMF , only : ESMF_FieldFill use ESMF , only : ESMF_KIND_R8 + use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL use med_internalstate_mod , only : nmappers, mapfcopy use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type @@ -967,6 +968,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ character(cl) :: field_name character(cl), allocatable :: field_namelist_dat(:) logical :: skip_mapping + type(ESMF_Region_Flag) :: zeroregion real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- @@ -1124,11 +1126,18 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ end do end if end do + + ! Set zeroregion option to select since we are blending data + zeroregion = ESMF_REGION_SELECT else ! Fill packed destination field/s with large value if data is unavailable - ! The data needs to be compated in the component side + ! The data needs to be merged in the component side + ! This is also required for mapfillv_bilnr interpolation type call ESMF_FieldFill(packed_data(mapindex)%field_dst, dataFillScheme="const", const1=fillValue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set zeroregion option to total since we have no data to blend + zeroregion = ESMF_REGION_TOTAL end if ! ----------------------------------- @@ -1174,6 +1183,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ field_dst=packed_data(mapindex)%field_dst, & routehandles=routehandles, & maptype=mapindex, & + zeroregiontype=zeroregion, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1360,7 +1370,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, end subroutine med_map_field_normalized !================================================================================ - subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, rc) + subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, zeroregiontype, rc) !--------------------------------------------------- ! map the source field to the destination field @@ -1370,7 +1380,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only : ESMF_Field, ESMF_FieldRegrid use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag - use ESMF , only : ESMF_REGION_SELECT + use ESMF , only : ESMF_REGION_TOTAL, ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle use ESMF , only : ESMF_FieldWriteVTK use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod @@ -1379,16 +1389,18 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables - type(ESMF_Field) , intent(in) :: field_src - type(ESMF_Field) , intent(inout) :: field_dst - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(in) :: maptype - character(len=*), optional, intent(in) :: fldname - integer, optional , intent(out) :: rc + type(ESMF_Field) , intent(in) :: field_src + type(ESMF_Field) , intent(inout) :: field_dst + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + integer , intent(in) :: maptype + character(len=*), optional , intent(in) :: fldname + type(ESMF_Region_Flag), optional, intent(in) :: zeroregiontype + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname + type(ESMF_Region_Flag) :: zeroregion character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1400,9 +1412,12 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r lfldname = 'unknown' if (present(fldname)) lfldname = trim(fldname) + zeroregion = ESMF_REGION_TOTAL + if (present(zeroregiontype)) zeroregion = zeroregiontype + if (maptype == mapnstod_consd) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1417,7 +1432,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else if (maptype == mapnstod_consf) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1440,7 +1455,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(maptype), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From 64e1c276dee0de636b03a9bd1186fb794699b02d Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Sun, 28 Jan 2024 19:35:04 -0700 Subject: [PATCH 23/31] fix Faxa_rainc issue when add_gusts is turned on --- mediator/med_phases_aofluxes_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 1d8efe7e8..5252e6edc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1597,6 +1597,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (add_gusts) then + call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if ! extra fields for ufs.frac.aoflux From 09dfd3c432cc97f7f4eb265c5be7a9b8f7127694 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 29 Jan 2024 09:28:27 -0600 Subject: [PATCH 24/31] fix comments mean -> inst and minor typo --- mediator/esmFldsExchange_hafs_mod.F90 | 48 +++++++++++++-------------- mediator/med.F90 | 2 +- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 5800516f9..b545b9b1c 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -244,13 +244,13 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then if (trim(coupling_mode) == 'hafs') then allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -260,11 +260,11 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) deallocate(F_flds) else allocate(F_flds(10,2)) - F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx - F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx @@ -521,13 +521,13 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then if (trim(coupling_mode) == 'hafs') then allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx do n = 1,size(F_flds,1) fldname1 = trim(F_flds(n,1)) fldname2 = trim(F_flds(n,2)) @@ -543,11 +543,11 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) deallocate(F_flds) else allocate(F_flds(10,2)) - F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! mean_net_lw_flx - F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! mean_sensi_heat_flx + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx diff --git a/mediator/med.F90 b/mediator/med.F90 index 928aba9eb..99ec6902c 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -950,7 +950,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif - ! Should terget component use all data for first time step? + ! Should target component use all data for first time step? do ncomp = 1,ncomps if (ncomp /= compmed) then call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) From c4f5082a871b32e11f28311b0c466f913f070a8d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 30 Jan 2024 14:27:56 -0600 Subject: [PATCH 25/31] minor fix - remove trim --- mediator/med.F90 | 2 +- mediator/med_map_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 99ec6902c..4a8d3d90b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1835,7 +1835,7 @@ subroutine DataInitialize(gcomp, rc) else if (trim(coupling_mode(1:3)) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'hafs') then + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f5ac5772f..bcf178fbd 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -414,7 +414,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask end if end if - if (trim(coupling_mode(1:4)) == 'hafs') then + if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if From e155c9ac743559c567611f20d905b0c14784cbc2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 13:56:21 -0700 Subject: [PATCH 26/31] srt does not work with most recent cime, cmeps requires most recent cdeps --- .github/workflows/srt.yml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 34252cb63..8765650cc 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -79,7 +79,14 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + # manage_externals does not work with the latest cime versions + git clone https://github.com/ESMCI/cime + cd cime + git submodule update --init + cd ../ + ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio + cd components/cdeps + git checkout main - name: Cache ESMF id: cache-esmf From 682a497b613ec396ea6c2f8236d3a22c7df11bc0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:53:08 -0700 Subject: [PATCH 27/31] fix cime checkout --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index ad580d275..eaf9973cf 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -79,11 +79,11 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio cd ccs_config - git checkout main - cd ../cime - git checkout master + git checkout main + cd ../ + git clone https://github.com/ESMCI/cime if [[ ! -e "${PWD}/.gitmodules.bak" ]] then echo "Convering git@github.com to https://github.com urls in ${PWD}/.gitmodules" From 87c473c73b6537951113cba0567ef95da068b93e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:53:45 -0700 Subject: [PATCH 28/31] turn off tmate --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index eaf9973cf..e75fae5b3 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -189,6 +189,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 From 12901407e0abb0e46b0191cde14252b87327e0ae Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 16:58:02 -0700 Subject: [PATCH 29/31] fix path --- .github/workflows/srt.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index e75fae5b3..d65dcb45f 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -84,9 +84,10 @@ jobs: git checkout main cd ../ git clone https://github.com/ESMCI/cime + cd cime if [[ ! -e "${PWD}/.gitmodules.bak" ]] then - echo "Convering git@github.com to https://github.com urls in ${PWD}/.gitmodules" + echo "Converting git@github.com to https://github.com urls in ${PWD}/.gitmodules" sed -i".bak" "s/git@github.com:/https:\/\/github.com\//g" "${PWD}/.gitmodules" fi From 455b2be66f1ae0b760183160ca5ed1e876f5d92e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 18:27:00 -0700 Subject: [PATCH 30/31] debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index d65dcb45f..1044661ba 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -190,6 +190,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 170adbe25abbf368b7f2aba89c69c12f6d4df751 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 30 Jan 2024 18:40:53 -0700 Subject: [PATCH 31/31] give format a length --- mediator/med_phases_cdeps_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 7b703e460..72ac560cc 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -170,7 +170,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (size(sdat(n1,n2)%stream) == 0 .and. streamid /= 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": initialize stream ", streamid + write(logunit,'(a,i3)') trim(subname)//": initialize stream ", streamid end if ! Allocate temporary variable to store file names in the stream @@ -258,7 +258,7 @@ subroutine med_phases_cdeps_run(gcomp, rc) if (size(sdat(n1,n2)%stream) > 0) then ! Debug print if (maintask) then - write(logunit,'(a,i)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) + write(logunit,'(a)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) end if ! Read data