From 185dc99bfb9ea608e8326d2772ff52d1a4487678 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Mon, 2 Dec 2024 11:21:31 -0700 Subject: [PATCH 1/7] ... From 92da7f0f7bd32065b2e4a5e5493a76f5b4cddb03 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 6 Dec 2024 10:37:18 -0700 Subject: [PATCH 2/7] add lgr%debug for platforms --- gridcomps/History/MAPL_HistoryGridComp.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 17deb2db1299..282801059ff7 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -5633,12 +5633,12 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) call split_string_by_space (line, length_mx, mxseg, & nplatform, str_piece, status) - !! to do: add debug - !write(6,*) 'line for obsplatforms=', trim(line) - !write(6,*) 'split string, nplatform=', nplatform - !write(6,*) 'nplf=', nplf - !write(6,*) 'str_piece=', str_piece(1:nplatform) - + call lgr%debug('%a %a', 'line for obsplatforms=', trim(line)) + call lgr%debug('%a %i6', 'split string, nplatform=', nplatform) + call lgr%debug('%a %i6', 'nplf=', nplf) + if (mapl_am_i_root()) then + write(6,*) ' str_piece=', str_piece(1:nplatform) + end if ! ! a) union the platform @@ -5654,7 +5654,10 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) end do end do deallocate(str_piece) - !! write(6,*) 'collection n=',n, 'map(:)=', map(:) + if (mapl_am_i_root()) then + write(6,*) 'collection n=',n, 'map(:)=', map(:) + end if + ! __ write common nc_index,time,lon,lat k=map(1) ! plat form # 1 From d3c94adf62499ced7ce150847d59ca05fb2f28ec Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Mon, 9 Dec 2024 09:26:06 -0700 Subject: [PATCH 3/7] Add print info to pin down this%item*xname vs obs(k)%ngeoval % name Next, inquire people how to make 'U;V' vector interpolation consistent with geoval names in Aerosol AOD: 'TOTEXTTAU' , 'GOCART2G' ,'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870', --- .../History/Sampler/MAPL_TrajectoryMod_smod.F90 | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 4ae3193970c9..48a87b22f176 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -194,6 +194,8 @@ STR1=trim(word(1)) else ! 3-item : var1 , 'root', var1_alias case + ! 3-item : var1 , 'root', 'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870', + ! 3-item : there is a problem of 'u;v' vector interpolation STR1=trim(word(3)) end if deallocate(word, _STAT) @@ -223,6 +225,9 @@ enddo end if + if (mapl_am_i_root()) then + print*, 'traj%obs(nobs)%ngeoval= ', jvar + end if do k=1, traj%nobs_type allocate (traj%obs(k)%metadata, _STAT) @@ -436,6 +441,9 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() + + if (mapl_am_I_root()) print*, 'create new bundle, this%items%xname= ', trim(item%xname) + if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) call ESMF_FieldGet(src_field,rank=rank,_RC) @@ -1056,6 +1064,8 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() + if (mapl_am_I_root()) print*, 'item%xname= ', trim(item%xname) + if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%acc_bundle,trim(item%xname),field=acc_field,_RC) call ESMF_FieldGet(acc_field,rank=rank,_RC) @@ -1067,6 +1077,7 @@ p_acc_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) _VERIFY(ierr) + print*, 'rank == 1' if (mapl_am_i_root()) then ! @@ -1100,6 +1111,8 @@ nx = this%obs(k)%nobs_epoch if (nx>0) then do ig = 1, this%obs(k)%ngeoval + print*, 'this%obs(k)%ngeoval= ', this%obs(k)%geoval_xname(ig) + if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p2d(1:nx), & start=[is],count=[nx]) @@ -1113,6 +1126,8 @@ end if else if (rank==2) then + print*, 'rank == 2' + call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_3d, _RC) dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) @@ -1191,6 +1206,8 @@ call ESMF_FieldDestroy(acc_field_3d_chunk, noGarbage=.true., _RC) call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) + stop 'nail 1' + _RETURN(_SUCCESS) end procedure append_file From 271edeea1fa9e496b5174a980be72e0d6c776f0a Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Sat, 14 Dec 2024 15:06:31 -0700 Subject: [PATCH 4/7] Add testing statement --- base/MAPL_ObsUtil.F90 | 1 + gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 | 8 +++++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/base/MAPL_ObsUtil.F90 b/base/MAPL_ObsUtil.F90 index 1b96fad92ae8..92afbe7fdc90 100644 --- a/base/MAPL_ObsUtil.F90 +++ b/base/MAPL_ObsUtil.F90 @@ -950,6 +950,7 @@ subroutine fglob(search_name, filename, rc) ! give the last name if (lenmax < slen) then if (MAPL_AM_I_ROOT()) write(6,*) 'pathlen vs filename_max_char_len: ', slen, lenmax _FAIL ('PATHLEN is greater than filename_max_char_len') + stop 'm1' end if if (slen>0) filename(1:slen)=c_filename(1:slen) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 48a87b22f176..c06d746980e3 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -465,6 +465,7 @@ end if call iter%next() enddo +! _FAIL('nail 1') _RETURN(_SUCCESS) end procedure create_new_bundle @@ -1064,7 +1065,7 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - if (mapl_am_I_root()) print*, 'item%xname= ', trim(item%xname) + if (mapl_am_I_root()) print*, 'regrid: item%xname= ', trim(item%xname) if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%acc_bundle,trim(item%xname),field=acc_field,_RC) @@ -1077,7 +1078,6 @@ p_acc_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) _VERIFY(ierr) - print*, 'rank == 1' if (mapl_am_i_root()) then ! @@ -1111,7 +1111,7 @@ nx = this%obs(k)%nobs_epoch if (nx>0) then do ig = 1, this%obs(k)%ngeoval - print*, 'this%obs(k)%ngeoval= ', this%obs(k)%geoval_xname(ig) + print*, 'this%obs(k)%geoval_xname(ig)= ', this%obs(k)%geoval_xname(ig) if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p2d(1:nx), & @@ -1124,6 +1124,8 @@ deallocate (this%obs(k)%p2d, _STAT) enddo end if + _FAIL('nail 1') + else if (rank==2) then print*, 'rank == 2' From f5fababd73f84c7ee9de21c1c000604204e4d648 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 10 Jan 2025 15:45:51 -0700 Subject: [PATCH 5/7] For splitField: var2 , "Root" , 'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870,' I did not modify jedi.rcx in trajectory sampler, instead I split this term into traj%obs(k)%geoval_xname(j) This assumes setting `jedi.splitField: 1` will trigger list(n)%items being regenerated in HISTORY. --- base/MAPL_ObsUtil.F90 | 12 ++-- base/Plain_netCDF_Time.F90 | 63 +++++++++++++++++- gridcomps/History/MAPL_HistoryGridComp.F90 | 22 ++++--- .../History/Sampler/MAPL_TrajectoryMod.F90 | 1 + .../Sampler/MAPL_TrajectoryMod_smod.F90 | 66 +++++++++++++------ 5 files changed, 129 insertions(+), 35 deletions(-) diff --git a/base/MAPL_ObsUtil.F90 b/base/MAPL_ObsUtil.F90 index 1cae659da842..679ed433c23f 100644 --- a/base/MAPL_ObsUtil.F90 +++ b/base/MAPL_ObsUtil.F90 @@ -52,7 +52,7 @@ module MAPL_ObsUtilMod character (len=ESMF_MAXSTR) :: var_name_time='' character (len=ESMF_MAXSTR) :: file_name_template='' integer :: ngeoval=0 - integer :: nentry_name=0 + integer :: nfield_name_mx=12 ! fix max character (len=ESMF_MAXSTR), allocatable :: field_name(:,:) !character (len=ESMF_MAXSTR), allocatable :: field_name(:) end type obs_platform @@ -770,7 +770,7 @@ function copy_platform_nckeys(a, rc) copy_platform_nckeys%var_name_lon = a%var_name_lon copy_platform_nckeys%var_name_lat = a%var_name_lat copy_platform_nckeys%var_name_time = a%var_name_time - copy_platform_nckeys%nentry_name = a%nentry_name + copy_platform_nckeys%nfield_name_mx = a%nfield_name_mx _RETURN(_SUCCESS) end function copy_platform_nckeys @@ -783,7 +783,7 @@ function union_platform(a, b, rc) integer, optional, intent(out) :: rc character (len=ESMF_MAXSTR), allocatable :: field_name_loc(:,:) - integer :: nfield, nentry_name + integer :: nfield, nfield_name_mx integer, allocatable :: tag(:) integer :: i, j, k integer :: status @@ -796,7 +796,7 @@ function union_platform(a, b, rc) k=nfield do j=1, b%ngeoval do i=1, a%ngeoval - if ( trim(b%field_name(1,j)) == trim(a%field_name(1,i)) ) then + if ( trim(b%field_name(1,j)) == trim(a%field_name(1,i)) ) then ! ygyu: potential problem here tag(j)=0 endif enddo @@ -804,9 +804,9 @@ function union_platform(a, b, rc) enddo union_platform%ngeoval=k nfield=k - nentry_name=union_platform%nentry_name + nfield_name_mx=union_platform%nfield_name_mx if ( allocated (union_platform%field_name) ) deallocate(union_platform%field_name) - allocate(union_platform%field_name(nentry_name, nfield)) + allocate(union_platform%field_name(nfield_name_mx, nfield)) do i=1, a%ngeoval union_platform%field_name(:,i) = a%field_name(:,i) enddo diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index b9c163816647..95bbe171e6a5 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -840,9 +840,16 @@ subroutine split_string_by_space (string_in, length_mx, & wc=0 ios=0 string = trim( adjustl(string_in) ) + str_piece(:)='' + i = index (string, mark) + if (i==0) then + nseg=1 + str_piece(1)=string + return + end if do while (ios==0) i = index (string, mark) - !!print*, 'index=', i + !! print*, 'ck index=', i if (i > 1) then wc = wc + 1 str_piece(wc)=trim(adjustl(string(1:i))) @@ -858,5 +865,59 @@ subroutine split_string_by_space (string_in, length_mx, & end subroutine split_string_by_space + subroutine split_string_by_seperator (string_in, length_mx, seperator_in, & + mxseg, nseg, str_piece, jstatus) + character (len=length_mx), intent (in) :: string_in + integer, intent (in) :: length_mx + character (len=length_mx), intent (in) :: seperator_in + integer, intent (in) :: mxseg + integer, intent (out):: nseg + character (len=length_mx), intent (out):: str_piece(mxseg) + integer, intent (out):: jstatus + character (len=length_mx) :: string_sc, string_oper, string_aux + character (len=1) :: mark, CH + integer :: ios + integer :: wc + integer :: len1, len2 + ! + ! "xxxx; yy; zz; uu, vv," + ! seperator = ";," + ! + + !__ s1. replace seperator by space + ! + string_sc = trim( adjustl(string_in) ) + string_oper = trim( adjustl(seperator_in) ) + len1 = len_trim(string_sc) + len2 = len_trim(string_oper) + string_aux=string_sc + do i = 1, len1 + CH = string_sc(i:i) + do j = 1, len2 + mark = string_oper(j:j) + if (CH==mark) then +! write(6,102) 'mark in', mark + string_aux(i:i)=' ' + end if + end do + end do + + !__ s2. split by space + call split_string_by_space (string_aux, length_mx, & + mxseg, nseg, str_piece, jstatus) + +! ! ygyu debug +! write(6,121) 'len1,len2', len1, len2 +! write(6,102) 'string_sc, string_oper', trim(string_sc), trim(string_oper) +! write(6,*) 'ck string_aux:', trim(string_aux) +! write(6,*) 'nseg', nseg +! do i=1, nseg +! write(6,*) 'output str_piece: ', trim(str_piece(i)) +! end do + + return + + include '/Users/yyu11/sftp/myformat.inc' + end subroutine split_string_by_seperator end module MAPL_scan_pattern_in_file diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index f743177d8fce..04544a32bdbe 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -964,6 +964,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) + ! ygyu: code runs here call parse_fields(cfg, trim(field_set_name), field_set, collection_name = list(n)%collection, items = list(n)%items, _RC) end if @@ -2484,7 +2485,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) end if if (list(n)%timeseries_output) then list(n)%trajectory = HistoryTrajectory(cfg,string,clock,genstate=GENSTATE,_RC) - call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) + call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,& + vdata=list(n)%vdata,_RC) IntState%stampoffset(n) = list(n)%trajectory%epoch_frequency elseif (list(n)%sampler_spec == 'mask') then call MAPL_TimerOn(GENSTATE,"mask_init") @@ -5464,7 +5466,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) integer :: nseg integer :: nseg_ub integer :: nfield, nplatform - integer :: nentry_name + integer :: nfield_name_max logical :: obs_flag integer, allocatable :: map(:) type(Logger), pointer :: lgr @@ -5554,7 +5556,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) - ! __ s2.1 scan fields: only determine ngeoval / nentry_name = nword + ! __ s2.1 scan fields: only determine ngeoval / nfield_name_max = nword allocate (str_piece(mxseg)) rewind(unitr) do k=1, nplf @@ -5578,10 +5580,10 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) end if enddo PLFS(k)%ngeoval = ngeoval - PLFS(k)%nentry_name = nseg_ub + nseg_ub = PLFS(k)%nfield_name_mx allocate ( PLFS(k)%field_name (nseg_ub, ngeoval) ) PLFS(k)%field_name = '' - !! print*, 'k, ngeoval, nentry_name', k, ngeoval, nseg_ub + !! print*, 'k, ngeoval, nfield_name_max', k, ngeoval, nseg_ub end do @@ -5613,6 +5615,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) nseg, str_piece, status) do m=1, nseg PLFS(k)%field_name (m, ngeoval) = trim(str_piece(m)) + !! write(6,*) 'm, trim(str_piece(m))', m, trim(str_piece(m)) end do endif enddo @@ -5621,6 +5624,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) rewind(unitr) + call lgr%debug('%a %i8','count PLATFORM.', nplf) if (mapl_am_i_root()) then do k=1, nplf @@ -5635,7 +5639,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) enddo enddo end if -!! write(6,*) 'nlist=', nlist + write(6,*) 'nlist=', nlist ! __ s3: Add more entry: 'obs_files:' and 'fields:' to rcx @@ -5722,10 +5726,10 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) end do nfield = p1%ngeoval - nentry_name = p1%nentry_name + nfield_name_max = p1%nfield_name_mx do j=1, nfield line='' - do i=1, nentry_name + do i=1, nfield_name_max line = trim(line)//' '//trim(p1%field_name(i,j)) enddo if (j==1) then @@ -5744,7 +5748,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) write(unitw, '(a)') trim(adjustl(PLFS(k)%file_name_template)) do j=1, PLFS(k)%ngeoval line='' - do i=1, nentry_name + do i=1, nfield_name_max line = trim(line)//' '//trim(adjustl(PLFS(k)%field_name(i,j))) enddo write(unitw, '(a)') trim(adjustl(line)) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 index 67eee93f452a..450feabfd49f 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 @@ -70,6 +70,7 @@ module HistoryTrajectoryMod integer :: obsfile_Te_index logical :: active ! case: when no obs. exist logical :: level_by_level = .false. + ! ! note ! for MPI_GATHERV of 3D data in procedure :: append_file ! we have choice LEVEL_BY_LEVEL or ALL_AT_ONCE (timing in sec below for extdata) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 27041392519e..22d39ce843da 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -29,22 +29,25 @@ module procedure HistoryTrajectory_from_config use BinIOMod + use MAPL_scan_pattern_in_file use pflogger, only : Logger, logging type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: epoch_frequency type(ESMF_TimeInterval) :: obs_time_span integer :: time_integer, second integer :: status - character(len=ESMF_MAXSTR) :: STR1, line + character(len=ESMF_MAXSTR) :: STR1, line, splitter character(len=ESMF_MAXSTR) :: symd, shms integer :: nline, col integer, allocatable :: ncol(:) character(len=ESMF_MAXSTR), allocatable :: word(:) + character(len=ESMF_MAXSTR), allocatable :: str_piece(:) integer :: nobs, head, jvar logical :: tend integer :: i, j, k, k2, M integer :: count, idx integer :: unitr, unitw + integer :: length_mx, mxseg, nseg type(GriddedIOitem) :: item type(Logger), pointer :: lgr @@ -155,6 +158,9 @@ ! __ s3. retrieve template and geoval, set metadata file_handle lgr => logging%get_logger('HISTORY.sampler') + length_mx = ESMF_MAXSTR + mxseg = 100 + allocate (str_piece(mxseg)) if ( nobs == 0 ) then ! ! treatment-1: @@ -200,13 +206,18 @@ ! 1-item case: file template or one-var ! 2-item : var1 , 'root' case STR1=trim(word(1)) - else - ! 3-item : var1 , 'root', var1_alias case + elseif ( count == 3 ) then + ! the Alias case + the splitField case + ! 3-item : var1 , 'root', var1_alias case ! 3-item : var1 , 'root', 'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870', ! 3-item : there is a problem of 'u;v' vector interpolation STR1=trim(word(3)) + else + STR1=trim(word(3)) + call lgr%debug('%a %i8', 'WARNING: there are more than 3 field_names in platform rcx' ) end if deallocate(word, _STAT) + if ( index(trim(STR1), '-----') == 0 ) then if (head==1 .AND. trim(STR1)/='') then nobs=nobs+1 @@ -215,28 +226,50 @@ head=0 else if (trim(STR1)/='') then - jvar=jvar+1 - idx = index(STR1,";") - if (idx==0) then - traj%obs(nobs)%geoval_xname(jvar) = STR1 + splitter=';,' + call split_string_by_seperator (STR1, length_mx, splitter, mxseg, & + nseg, str_piece, status) + if (count < 3) then + ! case + ! 'var1' + ! 'var1' , 'ROOT' + ! 'u;v' , 'ROOT' + jvar=jvar+1 + if (nseg==1) then + traj%obs(nobs)%geoval_xname(jvar) = STR1 + else + traj%obs(nobs)%geoval_xname(jvar) = trim(str_piece(1)) + traj%obs(nobs)%geoval_yname(jvar) = trim(str_piece(2)) + end if else - traj%obs(nobs)%geoval_xname(jvar) = trim(STR1(1:idx-1)) - traj%obs(nobs)%geoval_yname(jvar) = trim(STR1(idx+1:)) + ! case + ! 'var1' , 'ROOT' , alias + ! 'var1' , 'ROOT' , 'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870,' split_field + do j=1, nseg + jvar=jvar+1 + traj%obs(nobs)%geoval_xname(jvar) = trim(str_piece(j)) + end do end if end if end if else traj%obs(nobs)%ngeoval=jvar head=1 - jvar=0 + jvar=0 ! reset counter endif enddo end if if (mapl_am_i_root()) then - print*, 'traj%obs(nobs)%ngeoval= ', jvar + do k=1, nobs + do j=1, traj%obs(k)%ngeoval + write(6, '(2x,a,2x,2i10,2x,a)') & + 'traj%obs(k)%geoval_xname(j), k, j, xname ', k, j, trim(traj%obs(k)%geoval_xname(j)) + end do + end do end if + do k=1, traj%nobs_type allocate (traj%obs(k)%metadata, _STAT) if (mapl_am_i_root()) then @@ -1111,7 +1144,7 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - if (mapl_am_I_root()) print*, 'regrid: item%xname= ', trim(item%xname) + !! if (mapl_am_I_root()) print*, 'regrid: item%xname= ', trim(item%xname) if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%acc_bundle,trim(item%xname),field=acc_field,_RC) @@ -1157,7 +1190,7 @@ nx = this%obs(k)%nobs_epoch if (nx>0) then do ig = 1, this%obs(k)%ngeoval - print*, 'this%obs(k)%geoval_xname(ig)= ', this%obs(k)%geoval_xname(ig) + !! print*, 'this%obs(k)%geoval_xname(ig)= ', this%obs(k)%geoval_xname(ig) if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p2d(1:nx), & @@ -1170,11 +1203,8 @@ deallocate (this%obs(k)%p2d, _STAT) enddo end if - _FAIL('nail 1') - - else if (rank==2) then - print*, 'rank == 2' + else if (rank==2) then call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_3d, _RC) dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & @@ -1254,8 +1284,6 @@ call ESMF_FieldDestroy(acc_field_3d_chunk, noGarbage=.true., _RC) call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) - stop 'nail 1' - _RETURN(_SUCCESS) end procedure append_file From 0df2c64a1be7797c0e14cef72bc52507c22681ce Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 10 Jan 2025 17:13:52 -0700 Subject: [PATCH 6/7] . --- base/Plain_netCDF_Time.F90 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index 95bbe171e6a5..883f2871541d 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -849,11 +849,9 @@ subroutine split_string_by_space (string_in, length_mx, & end if do while (ios==0) i = index (string, mark) - !! print*, 'ck index=', i if (i > 1) then wc = wc + 1 str_piece(wc)=trim(adjustl(string(1:i))) - !!write(6,*) 'str_piece(wc)=', trim(str_piece(wc)) string = trim(adjustl(string(i:))) else ios=1 @@ -896,7 +894,6 @@ subroutine split_string_by_seperator (string_in, length_mx, seperator_in, & do j = 1, len2 mark = string_oper(j:j) if (CH==mark) then -! write(6,102) 'mark in', mark string_aux(i:i)=' ' end if end do @@ -906,18 +903,7 @@ subroutine split_string_by_seperator (string_in, length_mx, seperator_in, & call split_string_by_space (string_aux, length_mx, & mxseg, nseg, str_piece, jstatus) -! ! ygyu debug -! write(6,121) 'len1,len2', len1, len2 -! write(6,102) 'string_sc, string_oper', trim(string_sc), trim(string_oper) -! write(6,*) 'ck string_aux:', trim(string_aux) -! write(6,*) 'nseg', nseg -! do i=1, nseg -! write(6,*) 'output str_piece: ', trim(str_piece(i)) -! end do - return - - include '/Users/yyu11/sftp/myformat.inc' end subroutine split_string_by_seperator end module MAPL_scan_pattern_in_file From 0d4a8fa4e537468f1901edeaf1d8b5dbce2667dd Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 Jan 2025 12:44:57 -0700 Subject: [PATCH 7/7] small code cleanup --- CHANGELOG.md | 1 + base/MAPL_ObsUtil.F90 | 6 ++-- base/Plain_netCDF_Time.F90 | 2 ++ gridcomps/History/MAPL_HistoryGridComp.F90 | 20 ++++++------- .../Sampler/MAPL_TrajectoryMod_smod.F90 | 28 ++++++++----------- 5 files changed, 26 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f0c4478cdc38..a6b309c9ffa0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added loggers when writing or reading weight files - Added new option to AGCM.rc `overwrite_checkpoint` to allow checkpoint files to be overwritten. By default still will not overwrite checkpoints - The trajectory sampler netCDF output variable `location_index_in_iodafile` can be turned off, after we add two control variables: `use_NWP_1_file` and `restore_2_obs_vector` for users. When set to true, the two options will select only one obs file at each Epoch interval, and will rotate the output field index back to the location vector inthe obs file before generating netCDF output. +- Support `splitfield: 1` in HISTORY.rc for trajectory sampler ### Changed diff --git a/base/MAPL_ObsUtil.F90 b/base/MAPL_ObsUtil.F90 index 114a4eeeecf8..aed4c9adcd59 100644 --- a/base/MAPL_ObsUtil.F90 +++ b/base/MAPL_ObsUtil.F90 @@ -53,7 +53,7 @@ module MAPL_ObsUtilMod character (len=ESMF_MAXSTR) :: var_name_time='' character (len=ESMF_MAXSTR) :: file_name_template='' integer :: ngeoval=0 - integer :: nfield_name_mx=12 ! fix max + integer :: nfield_name_mx=12 character (len=ESMF_MAXSTR), allocatable :: field_name(:,:) !character (len=ESMF_MAXSTR), allocatable :: field_name(:) end type obs_platform @@ -797,7 +797,7 @@ function union_platform(a, b, rc) k=nfield do j=1, b%ngeoval do i=1, a%ngeoval - if ( trim(b%field_name(1,j)) == trim(a%field_name(1,i)) ) then ! ygyu: potential problem here + if ( trim(b%field_name(1,j)) == trim(a%field_name(1,i)) ) then tag(j)=0 endif enddo @@ -953,7 +953,7 @@ subroutine fglob(search_name, filename, rc) ! give the last name if (lenmax < slen) then if (MAPL_AM_I_ROOT()) write(6,*) 'pathlen vs filename_max_char_len: ', slen, lenmax _FAIL ('PATHLEN is greater than filename_max_char_len') - stop 'm1' + STOP 'lenmax < slen' end if if (slen>0) filename(1:slen)=c_filename(1:slen) diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index 883f2871541d..924ba9323978 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -849,9 +849,11 @@ subroutine split_string_by_space (string_in, length_mx, & end if do while (ios==0) i = index (string, mark) + !!print*, 'index=', i if (i > 1) then wc = wc + 1 str_piece(wc)=trim(adjustl(string(1:i))) + !!write(6,*) 'str_piece(wc)=', trim(str_piece(wc)) string = trim(adjustl(string(i:))) else ios=1 diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 04544a32bdbe..a6e95338cd1e 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -964,7 +964,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - ! ygyu: code runs here call parse_fields(cfg, trim(field_set_name), field_set, collection_name = list(n)%collection, items = list(n)%items, _RC) end if @@ -2485,8 +2484,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) end if if (list(n)%timeseries_output) then list(n)%trajectory = HistoryTrajectory(cfg,string,clock,genstate=GENSTATE,_RC) - call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,& - vdata=list(n)%vdata,_RC) + call list(n)%trajectory%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) IntState%stampoffset(n) = list(n)%trajectory%epoch_frequency elseif (list(n)%sampler_spec == 'mask') then call MAPL_TimerOn(GENSTATE,"mask_init") @@ -5615,7 +5613,6 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) nseg, str_piece, status) do m=1, nseg PLFS(k)%field_name (m, ngeoval) = trim(str_piece(m)) - !! write(6,*) 'm, trim(str_piece(m))', m, trim(str_piece(m)) end do endif enddo @@ -5624,7 +5621,6 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) rewind(unitr) - call lgr%debug('%a %i8','count PLATFORM.', nplf) if (mapl_am_i_root()) then do k=1, nplf @@ -5639,7 +5635,7 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) enddo enddo end if - write(6,*) 'nlist=', nlist +!! write(6,*) 'nlist=', nlist ! __ s3: Add more entry: 'obs_files:' and 'fields:' to rcx @@ -5686,9 +5682,9 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) call lgr%debug('%a %a', 'line for obsplatforms=', trim(line)) call lgr%debug('%a %i6', 'split string, nplatform=', nplatform) call lgr%debug('%a %i6', 'nplf=', nplf) - if (mapl_am_i_root()) then - write(6,*) ' str_piece=', str_piece(1:nplatform) - end if + !if (mapl_am_i_root()) then + ! write(6,*) ' str_piece=', str_piece(1:nplatform) + !end if ! ! a) union the platform @@ -5704,9 +5700,9 @@ subroutine regen_rcx_for_obs_platform (config, nlist, list, rc) end do end do deallocate(str_piece) - if (mapl_am_i_root()) then - write(6,*) 'collection n=',n, 'map(:)=', map(:) - end if + !if (mapl_am_i_root()) then + ! write(6,*) 'collection n=',n, 'map(:)=', map(:) + !end if ! __ write common nc_index,time,lon,lat diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 8a1c969eec78..d751474c3483 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -218,7 +218,7 @@ ! the Alias case + the splitField case ! 3-item : var1 , 'root', var1_alias case ! 3-item : var1 , 'root', 'TOTEXTTAU470;TOTEXTTAU550;TOTEXTTAU870', - ! 3-item : there is a problem of 'u;v' vector interpolation + ! 3-item : 'u;v' vector interpolation is not handled STR1=trim(word(3)) else STR1=trim(word(3)) @@ -263,19 +263,19 @@ else traj%obs(nobs)%ngeoval=jvar head=1 - jvar=0 ! reset counter + jvar=0 endif enddo end if - if (mapl_am_i_root()) then - do k=1, nobs - do j=1, traj%obs(k)%ngeoval - write(6, '(2x,a,2x,2i10,2x,a)') & - 'traj%obs(k)%geoval_xname(j), k, j, xname ', k, j, trim(traj%obs(k)%geoval_xname(j)) - end do - end do - end if + !!if (mapl_am_i_root()) then + !! do k=1, nobs + !! do j=1, traj%obs(k)%ngeoval + !! write(6, '(2x,a,2x,2i10,2x,a)') & + !! 'traj%obs(k)%geoval_xname(j), k, j, xname ', k, j, trim(traj%obs(k)%geoval_xname(j)) + !! end do + !! end do + !!end if do k=1, traj%nobs_type @@ -492,9 +492,7 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - - if (mapl_am_I_root()) print*, 'create new bundle, this%items%xname= ', trim(item%xname) - + !!if (mapl_am_I_root()) print*, 'create new bundle, this%items%xname= ', trim(item%xname) if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) call ESMF_FieldGet(src_field,rank=rank,_RC) @@ -516,7 +514,6 @@ end if call iter%next() enddo -! _FAIL('nail 1') _RETURN(_SUCCESS) end procedure create_new_bundle @@ -1185,7 +1182,7 @@ iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - !! if (mapl_am_I_root()) print*, 'regrid: item%xname= ', trim(item%xname) + !!if (mapl_am_I_root()) print*, 'regrid: item%xname= ', trim(item%xname) if (item%itemType == ItemTypeScalar) then call ESMF_FieldBundleGet(this%acc_bundle,trim(item%xname),field=acc_field,_RC) @@ -1259,7 +1256,6 @@ deallocate (this%obs(k)%p2d, _STAT) enddo end if - else if (rank==2) then call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_3d, _RC)