From fd65403a201c5a907e9d5794e91a18ec714790c3 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 29 Sep 2023 14:03:26 -0600 Subject: [PATCH 01/40] update for se scm --- cesm/driver/esm.F90 | 49 ++++++++++++++++++++++++++++++++------------- 1 file changed, 35 insertions(+), 14 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955a..605d01a34 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1224,13 +1224,17 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) real (r8), allocatable :: lats(:) ! temporary real (r8), allocatable :: lons(:) ! temporary real (r8), allocatable :: pos_lons(:) ! temporary + real (r8), allocatable :: pos_lats(:) ! temporary + real (r8), allocatable :: cols(:) ! temporary real (r8), allocatable :: glob_grid(:,:) ! temporary real (r8) :: pos_scol_lon ! temporary + real (r8) :: pos_scol_lat ! temporary real (r8) :: scol_data(1) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' + logical :: unstructured = .false. !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1324,7 +1328,15 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) if (status /= nf90_noerr) call shr_sys_abort (subname//' inq_varid frac') ! Read in domain file for single column - allocate(lats(nj)) + ! Check for unstructured data ni>1 and nj==1 + if (ni.gt.1 .and. nj == 1) unstructured=.true. + + if (unstructured) then + allocate(lats(ni)) + allocate(pos_lats(ni)) + else + allocate(lats(nj)) + end if allocate(lons(ni)) allocate(pos_lons(ni)) allocate(glob_grid(ni,nj)) @@ -1334,28 +1346,37 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) count3=(/ni,nj,1/) status = nf90_get_var(ncid, varid_xc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var xc') - do i = 1,ni - lons(i) = glob_grid(i,1) - end do + lons(1:ni) = glob_grid(1:ni,1) status = nf90_get_var(ncid, varid_yc, glob_grid, start3, count3) if (status /= nf90_noerr) call shr_sys_abort (subname//' get_var yc') - do j = 1,nj - lats(j) = glob_grid(1,j) - end do - + if (unstructured) then + lats(1:ni) = glob_grid(1:ni,1) + else + lats(1:nj) = glob_grid(1,1:nj) + end if ! find nearest neighbor indices of scol_lon and scol_lat in single_column_lnd_domain file ! convert lons array and scol_lon to 0,360 and find index of value closest to 0 ! and obtain single-column longitude/latitude indices to retrieve - pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) - pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) - start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) - start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) - + if (unstructured) then + allocate(cols(ni)) + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + pos_lats(:) = lats(:) + 90._r8 + pos_scol_lat = scol_lat + 90._r8 + cols=abs(pos_lons - pos_scol_lon)+abs(pos_lats - pos_scol_lat) + start(1) = MINLOC(cols, dim=1) + start(2) = 1 + deallocate(cols) + else + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scol_lon = mod(scol_lon + 360._r8, 360._r8) + start(1) = (MINLOC(abs(pos_lons - pos_scol_lon), dim=1)) + start(2) = (MINLOC(abs(lats -scol_lat ), dim=1)) + end if deallocate(lats) deallocate(lons) deallocate(pos_lons) deallocate(glob_grid) - ! read in value of nearest neighbor lon and RESET scol_lon and scol_lat ! also get area of gridcell, mask and frac status = nf90_get_var(ncid, varid_xc, scol_lon, start) From d86f4056d24e2243ef0d9148d92839cb636cfd22 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 25 Oct 2023 14:31:51 -0600 Subject: [PATCH 02/40] 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 03/40] 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 04/40] 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 05/40] 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 06/40] 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 07/40] 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 08/40] 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 09/40] 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 10/40] 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 11/40] 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 12/40] 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 13/40] 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 14/40] 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 15/40] 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 16/40] 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 17/40] 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 18/40] 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 19/40] 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 20/40] 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 21/40] 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 22/40] 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 23/40] 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 24/40] 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 25/40] 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 26/40] 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 27/40] 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 28/40] 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 29/40] 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 30/40] 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 31/40] 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 32/40] 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 From 41276365db776abf6ac69d6d190da72e08478d93 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 31 Jan 2024 09:20:23 -0500 Subject: [PATCH 33/40] fix dummy arguments w/o values --- ufs/glc_elevclass_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 6524f064f..626bb3ee0 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -37,6 +37,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l real(r8), intent(in) :: glc_topo(:) ! topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_without_bareland !----------------------------------------------------------------------- @@ -45,6 +46,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl real(r8), intent(in) :: glc_topo(:) ! ice topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_with_bareland !----------------------------------------------------------------------- @@ -57,11 +59,12 @@ end function glc_mean_elevation_virtual !----------------------------------------------------------------------- subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, logunit) - integer , intent(in) :: nec ! number of elevation classes + integer , intent(in) :: nec ! number of elevation classes real(r8), intent(in) :: glc_topo(:) ! topographic height real(r8), intent(in) :: glc_icefrac(:) real(r8), intent(out) :: glc_icefrac_ec(:,:) integer , intent(in) :: logunit + glc_icefrac_ec = 0.0_r8 end subroutine glc_get_fractional_icecov end module glc_elevclass_mod From 8cd4a32809a68102b38b4001fc9d55b31bf5c1c1 Mon Sep 17 00:00:00 2001 From: BinLi-NOAA Date: Thu, 1 Feb 2024 13:39:21 -0500 Subject: [PATCH 34/40] Update ccpp-physics in CMEPS to consider sea surface ocean current in air-sea flux computation (#107) * Update ufs/ccpp/data/MED_typedefs.meta. --- ufs/ccpp/data/MED_typedefs.F90 | 8 ++++++++ ufs/ccpp/data/MED_typedefs.meta | 20 ++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index e7c84506e..786ce4711 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -173,6 +173,7 @@ module MED_typedefs integer :: lsm_noahmp !< flag for NOAH MP land surface model logical :: redrag !< flag for reduced drag coeff. over sea integer :: sfc_z0_type !< surface roughness options over water + integer :: icplocn2atm !< flag controlling whether to consider ocean current in air-sea flux calculation logical :: thsfc_loc !< flag for reference pressure in theta calculation integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 integer :: lkm !< 0 = no lake model, 1 = lake model, 2 = lake & nsst on lake points @@ -249,6 +250,8 @@ module MED_typedefs real(kind=kind_phys), pointer :: fice(:) => null() !< ice fraction over open water real(kind=kind_phys), pointer :: hice(:) => null() !< sea ice thickness (m) real(kind=kind_phys), pointer :: tsfco(:) => null() !< sea surface temperature + real(kind=kind_phys), pointer :: usfco(:) => null() !< sea surface ocean current (zonal) + real(kind=kind_phys), pointer :: vsfco(:) => null() !< sea surface ocean current (merdional) real(kind=kind_phys), pointer :: uustar(:) => null() !< boundary layer parameter real(kind=kind_phys), pointer :: tsfc(:) => null() !< surface skin temperature real(kind=kind_phys), pointer :: snodi(:) => null() !< water equivalent snow depth over ice (mm) @@ -640,6 +643,7 @@ subroutine control_initialize(model) model%ivegsrc = 2 model%redrag = .false. model%sfc_z0_type = 0 + model%icplocn2atm = 0 model%thsfc_loc = .true. model%lsm = 1 model%lsm_noahmp = 2 @@ -739,6 +743,10 @@ subroutine sfcprop_create(sfcprop, im, model) sfcprop%hice = clear_val allocate(sfcprop%tsfco(im)) sfcprop%tsfco = clear_val + allocate(sfcprop%usfco(im)) + sfcprop%usfco = clear_val + allocate(sfcprop%vsfco(im)) + sfcprop%vsfco = clear_val allocate(sfcprop%uustar(im)) sfcprop%uustar = clear_val allocate(sfcprop%tsfc(im)) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 439a617a3..772358535 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -911,6 +911,12 @@ units = flag dimensions = () type = logical +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -1156,6 +1162,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [uustar] standard_name = surface_friction_velocity long_name = boundary layer parameter From 624920ddbd819c76ec37591c24e872308201810e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ufuk=20Turun=C3=A7o=C4=9Flu?= Date: Mon, 5 Feb 2024 13:15:00 -0700 Subject: [PATCH 35/40] Update CMEPS (#110) Sync w/ ESCOMP, adding CDEPS inline capability to CMEPS --- .github/workflows/extbuild.yml | 16 +- .github/workflows/srt.yml | 20 +- cesm/driver/esmApp.F90 | 2 +- cesm/flux_atmocn/shr_flux_mod.F90 | 41 ++- cime_config/buildnml | 10 +- cime_config/config_component.xml | 35 +-- cime_config/namelist_definition_drv.xml | 31 +- cime_config/runseq/runseq_TG.py | 2 +- cime_config/testdefs/testlist_drv.xml | 106 +++---- mediator/esmFldsExchange_cesm_mod.F90 | 20 ++ mediator/esmFldsExchange_hafs_mod.F90 | 363 ++++++++++++++++-------- mediator/fd_cesm.yaml | 4 + mediator/med.F90 | 34 ++- mediator/med_internalstate_mod.F90 | 37 ++- mediator/med_map_mod.F90 | 257 ++++++++++++----- mediator/med_methods_mod.F90 | 67 +++++ mediator/med_phases_aofluxes_mod.F90 | 32 ++- mediator/med_phases_cdeps_mod.F90 | 292 +++++++++++++++++++ mediator/med_phases_ocnalb_mod.F90 | 2 +- mediator/med_phases_post_atm_mod.F90 | 2 + mediator/med_phases_prep_atm_mod.F90 | 1 + mediator/med_phases_prep_ocn_mod.F90 | 52 +++- mediator/med_phases_prep_wav_mod.F90 | 33 ++- 23 files changed, 1133 insertions(+), 326 deletions(-) create mode 100644 mediator/med_phases_cdeps_mod.F90 diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 6e26b40a5..0614d5acb 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,11 +20,11 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.2 + ESMF_VERSION: v8.6.0 PNETCDF_VERSION: checkpoint.1.12.3 - NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_6_0 - CDEPS_VERSION: cdeps1.0.15 + NETCDF_FORTRAN_VERSION: v4.6.1 + PIO_VERSION: pio2_6_2 + CDEPS_VERSION: cdeps1.0.26 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -84,7 +84,7 @@ jobs: ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio @@ -102,6 +102,6 @@ jobs: make VERBOSE=1 popd - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 34252cb63..1044661ba 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.5.0 - PARALLELIO_VERSION: pio2_6_0 + ESMF_VERSION: v8.6.0 + PARALLELIO_VERSION: pio2_6_2 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -79,7 +79,21 @@ 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 ../ + git clone https://github.com/ESMCI/cime + cd cime + if [[ ! -e "${PWD}/.gitmodules.bak" ]] + then + 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 + git submodule update --init + cd ../components/cdeps + git checkout main - name: Cache ESMF id: cache-esmf diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 12cf1537d..5215ea2aa 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -139,7 +139,7 @@ program esmApp ! Call Run for the ensemble driver !----------------------------------------------------------------------------- call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9ec558737..58f7ae923 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -133,7 +133,7 @@ end subroutine shr_flux_adjust_constants ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” !=============================================================================== SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot, & + & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & & tbot ,us ,vs, pslv, & & ts ,mask , seq_flux_atmocn_minwind, & & sen ,lat ,lwup , & @@ -141,7 +141,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & evap ,evap_16O, evap_HDO, evap_18O, & & taux ,tauy ,tref ,qref , & & ocn_surface_flux_scheme, & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & + & add_gusts, & + & duu10n, & + & ugust_out, & + & ustar_sv ,re_sv ,ssq_sv, & & missval) ! !USES: @@ -156,11 +159,13 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & integer(IN),intent(in) :: nMax ! data vector length integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain integer(IN),intent(in) :: ocn_surface_flux_scheme + logical ,intent(in) :: add_gusts real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) @@ -188,6 +193,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) @@ -257,12 +263,31 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + ! Convective gustiness appropriate for input precipitation. + ! Following Regelsperger et al. (2000, J. Clim) + ! Ug = log(1.0+6.69R-0.476R^2) + ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) + ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) + + !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" @@ -317,7 +342,14 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (mask(n) /= 0) then !--- compute some needed quantities --- - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (add_gusts) then + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(rainc(n),6.94444e-4_r8)) ) + ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) + else + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + ugust_out(n) = 0.0_r8 + end if + if (use_coldair_outbreak_mod) then ! Cold Air Outbreak Modification: ! Increase windspeed for negative tbot-ts @@ -452,6 +484,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ugust_out(n) = spval ! gustiness addition (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval diff --git a/cime_config/buildnml b/cime_config/buildnml index 32be8ead4..ff2553be7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -15,6 +15,7 @@ from CIME.case import Case from CIME.nmlgen import NamelistGenerator from CIME.utils import expect from CIME.utils import get_model, get_time_in_seconds, get_timestamp +from CIME.namelist import literal_to_python_value from CIME.buildnml import create_namelist_infile, parse_input from CIME.XML.files import Files @@ -105,7 +106,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_OCN"] = case.get_value("COMP_OCN") config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") - + config["CAMDEV"] = "True" if "CAM%DEV" in case.get_value("COMPSET") else "False" + if ( ( case.get_value("COMP_ROF") == "mosart" @@ -144,6 +146,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): nmlgen.set_value("aqua_planet", value=".true.") + # make sure that variable add_gusts is only set to true if compset includes cam_dev + add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") + if add_gusts: + expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) + # -------------------------------- # Overwrite: set component coupling frequencies # -------------------------------- @@ -658,6 +665,7 @@ def buildnml(case, caseroot, component): create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) infile = [namelist_infile] + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index a329be743..938e0e31c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -534,6 +534,15 @@ List of job ids for most recent case.submit + + char + regular + regular,premium,economy + run_begin_stop_restart + env_run.xml + job priority for systems supporting this option + + @@ -812,15 +821,6 @@ different MPI ranks to different GPUs within the same compute node - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies that at least one of the components is built threaded (DO NOT EDIT) - - logical TRUE,FALSE @@ -1026,23 +1026,6 @@ this to work. - - char - ESMF_LOGKIND_SINGLE,ESMF_LOGKIND_MULTI,ESMF_LOGKIND_NONE - ESMF_LOGKIND_NONE - run_flags - env_run.xml - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files -- one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - char off,low,high,max diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index dec6868f1..3e4d6bf6b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -18,24 +18,6 @@ - - char - cime_pes - PELAYOUT_attributes - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - $ESMF_LOGFILE_KIND - - - integer pio @@ -964,6 +946,19 @@ + + logical + control + MED_attributes + + add a wind gustiness factor + + + .true. + .false. + + + logical budget diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index c0bb4ab92..dea8aede5 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -34,7 +34,7 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED med_phases_post_lnd" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) - runseq.add_action ("GLC" , run_glc) + runseq.add_action ("GLC" , run_glc and med_to_glc) runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) runseq.add_action ("MED med_phases_history_write" , True) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 985bd6ce9..e17b2ffcf 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -5,36 +5,36 @@ - + - + - + - + - + - + - + - + @@ -46,18 +46,18 @@ - + - + - + - + @@ -69,18 +69,18 @@ - + - + - + - + @@ -92,27 +92,27 @@ - + - + - + - + - + - + @@ -124,27 +124,27 @@ - + - + - + - + - + - + @@ -156,9 +156,9 @@ - + - + @@ -170,24 +170,24 @@ - + - + - + - + - + @@ -200,36 +200,36 @@ - + - + - + - + - + - + - + - + @@ -241,18 +241,18 @@ - + - + - + - + @@ -263,18 +263,18 @@ - + - + - + - + @@ -282,9 +282,9 @@ - + - + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a2c4fe435..c7cee8d98 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -276,6 +276,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_shum') call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') + call addfld_from(compatm, 'Faxa_rainc') if (flds_wiso) then call addfld_from(compatm, 'Sa_shum_wiso') end if @@ -288,6 +289,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) end if + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) @@ -1365,6 +1367,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to atm: unmerged ugust_out from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 1f645524e..b545b9b1c 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,18 @@ 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 (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 + !===================================================================== ! FIELDS TO ATMOSPHERE !===================================================================== @@ -154,28 +167,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 +212,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 '/) ! 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)) + 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 '/) ! 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 + 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 +288,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 +414,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 +477,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 '/) ! 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)) + 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 '/) ! 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 + 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/fd_cesm.yaml b/mediator/fd_cesm.yaml index c09a63c58..eaef1dc78 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -487,6 +487,10 @@ canonical_units: m description: atmosphere import # + - standard_name: So_ugustOut + canonical_units: m/s + description: atmosphere import + # #----------------------------------- # section: land-ice export # Note that the fields sent from glc->med do NOT have elevation classes, diff --git a/mediator/med.F90 b/mediator/med.F90 index 87bbb2fac..4a8d3d90b 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 @@ -934,6 +950,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + ! 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) + 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) @@ -1803,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) == '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_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fbe4617cf..b06f20c1c 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 @@ -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] @@ -119,10 +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 - 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. @@ -147,10 +149,10 @@ 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 ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -173,6 +175,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 @@ -303,6 +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_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)) @@ -316,6 +323,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 @@ -364,6 +372,15 @@ 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 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 3428d2268..f77d4242e 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 (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if @@ -429,6 +429,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif end if + if (trim(coupling_mode) == 'hafs.mom6') then + polemethod = ESMF_POLEMETHOD_NONE + endif ! Create route handle if (mapindex == mapfcopy) then @@ -893,12 +896,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 @@ -919,7 +924,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, use_data, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -929,33 +934,47 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d 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 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 + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! 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 + logical, optional , intent(in) :: use_data ! skip mapping and use data instead + 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(:) + logical :: isFound + 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) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -977,6 +996,22 @@ 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 + skip_mapping = .false. + 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 + + if (present(use_data)) skip_mapping = use_data + end if + end if ! Loop over mapping types do mapindex = 1,nmappers @@ -1012,6 +1047,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d ! 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 @@ -1027,8 +1063,90 @@ 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)//" search "//trim(field_name)//" field for background fill." + + ! Check if field has match in data fields + isFound = .false. + do nfd = 1, fieldcount_dat + ! 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 + 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(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + 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 + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if + end if + end do ! loop for destination fields + + ! 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 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 + ! ----------------------------------- ! Do the mapping ! ----------------------------------- @@ -1063,30 +1181,36 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d 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, & + zeroregiontype=zeroregion, & + 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') @@ -1127,8 +1251,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) @@ -1250,7 +1378,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 @@ -1258,29 +1386,29 @@ 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_TERMORDER_SRCSEQ, ESMF_Region_Flag + 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 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 + type(ESMF_Region_Flag), optional, intent(in) :: zeroregiontype + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname - real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 + type(ESMF_Region_Flag) :: zeroregion character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1292,9 +1420,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_TOTAL, 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) @@ -1309,7 +1440,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=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) @@ -1323,12 +1454,6 @@ 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_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 diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 649c9c511..d4bdab2a7 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(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) + 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_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 8c3d87c61..5252e6edc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -78,6 +78,7 @@ module med_phases_aofluxes_mod logical :: compute_atm_dens logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case + logical :: add_gusts character(len=CS), pointer :: fldnames_ocn_in(:) character(len=CS), pointer :: fldnames_atm_in(:) @@ -125,6 +126,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + real(R8) , pointer :: rainc (:) => null() ! convective rain flux ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell @@ -146,6 +148,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared + real(R8) , pointer :: ugust_out (:) => null() ! diagnostic: gust wind added real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq @@ -402,6 +405,14 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) end if #endif + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) add_gusts + else + add_gusts = .false. + end if + ! bottom level potential temperature and/or botom level density ! will need to be computed if not received from the atm if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_ptem', rc=rc)) then @@ -1052,6 +1063,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rainc=aoflux_in%rainc, & s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & @@ -1060,7 +1072,10 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & + add_gusts=add_gusts, & + duu10n=aoflux_out%duu10n, & + ugust_out = aoflux_out%ugust_out, & + ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) #else @@ -1084,7 +1099,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, missval=0.0_r8) + duu10n=aoflux_out%duu10n, & + missval=0.0_r8) #ifdef UFS_AOFLUX end if #endif @@ -1581,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 @@ -1704,6 +1724,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 @@ -1717,6 +1738,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 !================================================================================ diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 new file mode 100644 index 000000000..72ac560cc --- /dev/null +++ b/mediator/med_phases_cdeps_mod.F90 @@ -0,0 +1,292 @@ +module med_phases_cdeps_mod + + 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, 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, 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: 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 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 + 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 + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public med_phases_cdeps_run + + !-------------------------------------------------------------------------- + ! 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) :: stream ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:,:) ! input data stream + + 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 + + ! local variables + 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 :: found + 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) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + ! 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 sdat streams + if (.not. allocated(sdat)) allocate(sdat(ncomps,ncomps)) + sdat(:,:)%mainproc = (localPet == 0) + + ! Initialize cdeps inline + if (first_time) then + ! 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_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 + + ! 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) + 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 + 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 !!! + 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 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,i3)') trim(subname)//": initialize 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)), & + 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) + + ! Set flag + found = .true. + end if + end do ! nflds + + ! Create empty FB + 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 + 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 + + ! 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)') 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 + + ! Point FB from internal one + 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%FBData(n2), 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 med_phases_cdeps_run + +end module med_phases_cdeps_mod diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 31bd211f0..304d0c7fd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -242,7 +242,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) end if end if - write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 9ed1b78d4..333497a69 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) @@ -104,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) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index abb6b7d5b..b9e7582e1 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) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d76f3e81a..d911d93e1 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 @@ -438,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 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 14878f49cbfb15c422bf54718214e7af5555f8a9 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sun, 3 Mar 2024 08:19:59 -0500 Subject: [PATCH 36/40] add cpl_scalar for tiled grids, other minor fixes * add new cpl_scalar for mediator history files for tiled gridded domains, eg cube-sphere. Replaces existing use of config variables which restricted the use to 6-tiles domain * remove unnecessary trims, fix minor typos and indentation --- mediator/med.F90 | 34 +++++++--- mediator/med_fraction_mod.F90 | 6 +- mediator/med_internalstate_mod.F90 | 8 ++- mediator/med_io_mod.F90 | 41 ++++++----- mediator/med_map_mod.F90 | 102 ++++++++++++++-------------- mediator/med_phases_history_mod.F90 | 42 ++++-------- 6 files changed, 117 insertions(+), 116 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 4a8d3d90b..7c379ad90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capabilty !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -832,10 +832,10 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='advertise', 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='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else @@ -867,6 +867,15 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) is_local%wrap%flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", 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%flds_scalar_index_ntile + else + is_local%wrap%flds_scalar_index_ntile = 0 + end if + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -962,7 +971,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif if (maintask) then write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) - endif + endif end if end do @@ -1067,7 +1076,7 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! Recieve Grids + ! Receive Grids !------------------ do n1 = 1,ncomps @@ -1644,7 +1653,7 @@ subroutine DataInitialize(gcomp, rc) logical :: read_restart logical :: allDone = .false. logical,save :: first_call = .true. - real(r8) :: real_nx, real_ny + real(r8) :: real_nx, real_ny, real_ntile character(len=CX) :: msgString character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- @@ -1832,7 +1841,7 @@ subroutine DataInitialize(gcomp, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:4) == 'hafs') then @@ -2128,11 +2137,18 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) + is_local%wrap%ntile(n1) = nint(real_ntile) + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then - write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2f7d43041..b0cd53a61 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -293,7 +293,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ice and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -345,7 +345,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ocn and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -756,7 +756,7 @@ subroutine med_fraction_set(gcomp, rc) call t_startf('MED:'//trim(subname)//' fbfrac(compatm)') ! Determine maptype - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b06f20c1c..5609f5ea6 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,7 +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_data_active(:,:) ! uses stream data to provide background fill + 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 @@ -132,13 +132,14 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:) + integer, pointer :: nx(:), ny(:), ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_ntile = 0 integer :: flds_scalar_index_nextsw_cday = 0 integer :: flds_scalar_index_precip_factor = 0 real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn @@ -312,6 +313,7 @@ subroutine med_internalstate_init(gcomp, rc) 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%ntile(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) @@ -601,7 +603,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0 if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 - if ( trim(coupling_mode(1:3)) == 'ufs') then + if ( coupling_mode(1:3) == 'ufs') then if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 endif if ( trim(coupling_mode) == 'hafs') then diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 265a5ddda..f4abadaf6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -698,7 +698,7 @@ end function med_io_sec2hms !=============================================================================== subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, tilesize, rc) + fillval, pre, flds, tavg, use_float, ntile, rc) !--------------- ! Write FB to netcdf file @@ -728,7 +728,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles + integer, optional , intent(in) :: ntile ! number of nx * ny tiles integer , intent(out):: rc ! local variables @@ -754,7 +754,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(CS) :: coordvarnames(2) ! coordinate variable names character(CS) :: coordnames(2) ! coordinate long names character(CS) :: coordunits(2) ! coordinate units - integer :: lnx,lny + integer :: lnx,lny,lntile logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) @@ -770,8 +770,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & integer :: rank integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields - logical :: atmtiles - integer :: ntiles = 1 + logical :: tiles character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- @@ -785,9 +784,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & luse_float = .false. if (present(use_float)) luse_float = use_float - atmtiles = .false. - if (present(tilesize)) then - if (tilesize > 0) atmtiles = .true. + tiles = .false. + if (present(ntile)) then + if (ntile > 0) tiles = .true. end if ! Error check @@ -870,14 +869,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! all the global grid values in the distgrid - e.g. CTSM ng = maxval(maxIndexPTile) - if (atmtiles) then - lnx = tilesize - lny = tilesize - ntiles = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles + if (tiles) then + lnx = nx + lny = ny + lntile = ng/(lnx*lny) + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (ntiles /= 6) then - call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) + if (lntile /= ntile) then + call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif else @@ -900,10 +899,10 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then - if (atmtiles) then + if (tiles) then rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,8 +1019,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (atmtiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc) + if (tiles) then + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) else call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) @@ -1579,8 +1578,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) allocate(fldptr1_tmp(lsize)) do n = 1,ungriddedUBound(1) - ! Creat a name for the 1d field on the mediator history or restart file based on the - ! ungridded dimension index of the field bundle 2d fiedl + ! Create a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d field write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f77d4242e..2c4da67b4 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -408,7 +408,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if - if (trim(coupling_mode(1:3)) == 'ufs') then + if (coupling_mode(1:3) == 'ufs') then if (n1 == compatm .and. n2 == complnd) then srcMaskValue = ispval_mask dstMaskValue = ispval_mask @@ -424,7 +424,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) polemethod=ESMF_POLEMETHOD_ALLAVG - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:3)) == 'ufs') then + if (trim(coupling_mode) == 'cesm' .or. coupling_mode(1:3) == 'ufs') then if (n1 == compwav .or. n2 == compwav) then polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif @@ -949,7 +949,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ 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 + 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 @@ -1008,7 +1008,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ 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 @@ -1072,7 +1072,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ call t_stopf('MED:'//trim(subname)//' copy from src') ! ----------------------------------- - ! Fill destination field with background data provided by CDEPS inline + ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- if (fieldcount_dat > 0) then @@ -1085,52 +1085,52 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! 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)//" search "//trim(field_name)//" field for background fill." - - ! Check if field has match in data fields - isFound = .false. - do nfd = 1, fieldcount_dat - ! 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 - 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(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Fill destination field with background data coming from stream - dataptr2d_packed(np,:) = dataptr(:) - - if (dbug_flag > 1) then - 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 - isFound = .true. - exit - end if - end do ! loop for stream fields - - ! Could not find match in the list of stream fields - if (.not. isFound) then - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" - - ! Fill destination field with very large background data - dataptr2d_packed(np,:) = fillValue - end if + ! 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 + isFound = .false. + do nfd = 1, fieldcount_dat + ! 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 + 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(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + 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 + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if end if end do ! loop for destination fields diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7d59a7fea..606b6159b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -322,12 +322,14 @@ subroutine med_phases_history_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if @@ -672,13 +674,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -694,16 +696,6 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. instfile%is_clockset) then @@ -775,22 +767,23 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) + nt=1, pre='Med_frac_'//trim(compname(compid)), ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -830,13 +823,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -854,16 +847,6 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. avgfile%is_clockset) then @@ -982,9 +965,10 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if (is_local%wrap%comp_present(compid)) then nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) @@ -993,7 +977,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) From 3515360f67a4f17ed6788646ff5851e347f0c57e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 3 Mar 2024 13:51:44 -0500 Subject: [PATCH 37/40] set ntile=0 when ntile scalar doesn't exist --- mediator/med.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 7c379ad90..9c7572a90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -882,7 +882,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday else - is_local%wrap%flds_scalar_index_nextsw_cday = spval + is_local%wrap%flds_scalar_index_nextsw_cday = 0 end if call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -2137,15 +2137,19 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_GetScalar(scalar_value=real_ntile, & - scalar_id=is_local%wrap%flds_scalar_index_ntile, & - state=is_local%wrap%NstateImp(n1), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_local%wrap%flds_scalar_index_ntile > 0) then + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ntile(n1) = nint(real_ntile) + else + is_local%wrap%ntile(n1) = 0 + end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - is_local%wrap%ntile(n1) = nint(real_ntile) write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) From ac5520fa195cf5136f0a836b7183cf06d87d052f Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 4 Mar 2024 17:11:56 -0500 Subject: [PATCH 38/40] fix restarts when ntile>0 --- mediator/med.F90 | 2 +- mediator/med_internalstate_mod.F90 | 4 +++- mediator/med_phases_restart_mod.F90 | 4 ++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 9c7572a90..dc0f68cf2 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capability !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 5609f5ea6..e45331f76 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -132,7 +132,9 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:), ntile(:) + integer, pointer :: nx(:), ny(:) + ! Number of nx*ny domains (needed for cubed-sphere and regional domains) + integer, pointer :: ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index a225ff97c..1bbbb0fbf 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -346,6 +346,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) + if (is_local%wrap%ntile(n) > 0) then + nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) + ny = 1 + end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & From 45d63c4384b8244cdc596435c94fd946c5b9761c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 13 Mar 2024 10:02:36 -0600 Subject: [PATCH 39/40] add two fixes * testing of this feature w/ UFS noahmp lnd component, which currently runs on the CSG, found two issues. One to write the mediator fractions and areas on the tiles when using the single history file. A second fix is the mapping masking for lnd-atm coupling in UFS. --- mediator/med_map_mod.F90 | 4 ++++ mediator/med_phases_history_mod.F90 | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2c4da67b4..c20fe4bdc 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -413,6 +413,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, srcMaskValue = ispval_mask dstMaskValue = ispval_mask end if + if (n1 == complnd .and. n2 == compatm) then + srcMaskValue = ispval_mask + dstMaskValue = 0 + end if end if if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 606b6159b..52b20c035 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -336,12 +336,14 @@ subroutine med_phases_history_write(gcomp, rc) ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created From 8309884aa4ef46caa672b3e38fd0b6a9bc18c199 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 13 Mar 2024 18:28:59 -0400 Subject: [PATCH 40/40] modify dstmask for lnd->atm in UFS --- mediator/med_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index c20fe4bdc..3d888bcfa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -415,7 +415,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if if (n1 == complnd .and. n2 == compatm) then srcMaskValue = ispval_mask - dstMaskValue = 0 + dstMaskValue = ispval_mask end if end if if (coupling_mode(1:4) == 'hafs') then