From 29f34fda3626348865d7d0576a25dcc117d6a06f Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 1 May 2024 15:46:22 -0600 Subject: [PATCH 01/61] Add a few first level timer for sampelr code in MAPL_HistoryGridComp.F90 --- gridcomps/History/MAPL_HistoryCollection.F90 | 2 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 24 +++++++++++++++----- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryCollection.F90 b/gridcomps/History/MAPL_HistoryCollection.F90 index f423b35a21ea..39f3c0b723d1 100644 --- a/gridcomps/History/MAPL_HistoryCollection.F90 +++ b/gridcomps/History/MAPL_HistoryCollection.F90 @@ -9,7 +9,7 @@ module MAPL_HistoryCollectionMod use MAPL_VerticalDataMod use MAPL_TimeDataMod use HistoryTrajectoryMod - use MaskSamplerGeosatMod + use MaskSamplerGeosatMod use StationSamplerMod use gFTL_StringStringMap use MAPL_EpochSwathMod diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4eaf29f21c46..ccf3cc8b792a 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3451,7 +3451,7 @@ subroutine Run ( gc, import, export, clock, rc ) ! swath only epoch_swath_grid_case: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) - call MAPL_TimerOn(GENSTATE,"SwathGen") + call MAPL_TimerOn(GENSTATE,"SwathRun") if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then call Hsampler%regrid_accumulate(list(n)%xsampler,_RC) @@ -3478,7 +3478,7 @@ subroutine Run ( gc, import, export, clock, rc ) call list(n)%mGriddedIO%set_param(write_collection_id=collection_id) endif end if - call MAPL_TimerOff(GENSTATE,"SwathGen") + call MAPL_TimerOff(GENSTATE,"SwathRun") call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_grid_case @@ -3537,12 +3537,15 @@ subroutine Run ( gc, import, export, clock, rc ) lgr => logging%get_logger('HISTORY.sampler') if (list(n)%timeseries_output) then + call MAPL_TimerOn(GENSTATE,"TrajectoryRun") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then call list(n)%trajectory%create_file_handle(filename(n),_RC) list(n)%currentFile = filename(n) list(n)%unit = -1 end if + call MAPL_TimerOff(GENSTATE,"TrajectoryRun") elseif (list(n)%sampler_spec == 'station') then + call MAPL_TimerOn(GENSTATE,"StationRun") if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& "Station_data output to new file:",trim(filename(n))) @@ -3551,7 +3554,9 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 end if + call MAPL_TimerOff(GENSTATE,"StationRun") elseif (list(n)%sampler_spec == 'mask') then + call MAPL_TimerOn(GENSTATE,"MaskRun") if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& "Mask_data output to new file:",trim(filename(n))) @@ -3560,6 +3565,7 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 end if + call MAPL_TimerOff(GENSTATE,"MaskRun") else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then @@ -3645,6 +3651,7 @@ subroutine Run ( gc, import, export, clock, rc ) if (.not.list(n)%timeseries_output .AND. & list(n)%sampler_spec /= 'station' .AND. & list(n)%sampler_spec /= 'mask') then + IOTYPE: if (list(n)%unit < 0) then ! CFIO call list(n)%mGriddedIO%bundlepost(list(n)%currentFile,oClients=o_Clients,_RC) else @@ -3692,11 +3699,15 @@ subroutine Run ( gc, import, export, clock, rc ) end if if (list(n)%sampler_spec == 'station') then + call MAPL_TimerOn(GENSTATE,"StationRun") call ESMF_ClockGet(clock,currTime=current_time,_RC) call list(n)%station_sampler%append_file(current_time,_RC) + call MAPL_TimerOff(GENSTATE,"StationRun") elseif (list(n)%sampler_spec == 'mask') then + call MAPL_TimerOn(GENSTATE,"MaskRun") call ESMF_ClockGet(clock,currTime=current_time,_RC) call list(n)%mask_sampler%append_file(current_time,_RC) + call MAPL_TimerOff(GENSTATE,"MaskRun") endif endif OUTTIME @@ -3724,8 +3735,8 @@ subroutine Run ( gc, import, export, clock, rc ) ! swath only epoch_swath_regen_grid: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) - call MAPL_TimerOn(GENSTATE,"Swath regen") if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then + call MAPL_TimerOn(GENSTATE,"SwathRun") if( ESMF_AlarmIsRinging ( Hsampler%alarm ) .and. .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then key_grid_label = list(n)%output_grid_label @@ -3736,8 +3747,8 @@ subroutine Run ( gc, import, export, clock, rc ) ogrid=pgrid,vdata=list(n)%vdata,_RC) if( MAPL_AM_I_ROOT() ) write(6,'(//)') endif + call MAPL_TimerOff(GENSTATE,"SwathRun") end if - call MAPL_TimerOff(GENSTATE,"Swath regen") call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_regen_grid @@ -3754,8 +3765,9 @@ subroutine Run ( gc, import, export, clock, rc ) WRITELOOP: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) - call MAPL_TimerOn(GENSTATE,"Write Timeseries") + if (list(n)%timeseries_output) then + call MAPL_TimerOn(GENSTATE,"TrajectoryRun") call list(n)%trajectory%regrid_accumulate(_RC) if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then call list(n)%trajectory%append_file(current_time,_RC) @@ -3764,6 +3776,7 @@ subroutine Run ( gc, import, export, clock, rc ) call list(n)%trajectory%destroy_rh_regen_LS (_RC) end if end if + call MAPL_TimerOff(GENSTATE,"TrajectoryRun") end if if( Writing(n) .and. list(n)%unit < 0) then @@ -3772,7 +3785,6 @@ subroutine Run ( gc, import, export, clock, rc ) end if - call MAPL_TimerOff(GENSTATE,"Write Timeseries") call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) enddo WRITELOOP From 1270aed5d1ac393c9e6f2fa2533404629baab9de Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 3 May 2024 11:53:05 -0400 Subject: [PATCH 02/61] avoid "done" message when there is no request --- CHANGELOG.md | 2 ++ pfio/BaseThread.F90 | 12 ++++++++++++ pfio/ClientThread.F90 | 16 ++++++++++++++++ 3 files changed, 30 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index bb095ae09e1a..02a92546ba6c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- pFIO Clients don't send "Done" message when there is no request + ### Fixed ### Removed diff --git a/pfio/BaseThread.F90 b/pfio/BaseThread.F90 index d5eb16e9c987..32dc7dc18c8b 100644 --- a/pfio/BaseThread.F90 +++ b/pfio/BaseThread.F90 @@ -29,6 +29,7 @@ module pFIO_BaseThreadMod procedure :: clear_RequestHandle procedure :: get_RequestHandle procedure :: insert_RequestHandle + procedure :: isEmpty_RequestHandle end type BaseThread contains @@ -66,6 +67,17 @@ function get_RequestHandle(this,request_id, rc) result(rh_ptr) _RETURN(_SUCCESS) end function get_RequestHandle + function isEmpty_RequestHandle(this, rc) result(empty) + class (BaseThread), target, intent(in) :: this + integer, optional, intent(out) :: rc + logical :: empty + type (IntegerRequestMapIterator) :: iter + + iter = this%open_requests%begin() + empty = (iter == this%open_requests%end()) + _RETURN(_SUCCESS) + end function isEmpty_RequestHandle + subroutine insert_RequestHandle(this,request_id, handle, rc) class (BaseThread), target, intent(inout) :: this integer, intent(in) :: request_id diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 40b778c633d7..146c0f9b4745 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -410,6 +410,10 @@ subroutine done_prefetch(this, rc) class(AbstractSocket),pointer :: connection integer :: status + if (this%isEmpty_RequestHandle()) then + _RETURN(_SUCCESS) + endif + connection=>this%get_connection() call connection%send(PrefetchDoneMessage(),_RC) _RETURN(_SUCCESS) @@ -420,6 +424,10 @@ subroutine done_collective_prefetch(this, rc) integer, optional, intent(out) :: rc class(AbstractSocket),pointer :: connection integer :: status + + if (this%isEmpty_RequestHandle()) then + _RETURN(_SUCCESS) + endif connection=>this%get_connection() call connection%send(CollectivePrefetchDoneMessage(),_RC) @@ -432,6 +440,10 @@ subroutine done_stage(this, rc) class(AbstractSocket),pointer :: connection integer :: status + if (this%isEmpty_RequestHandle()) then + _RETURN(_SUCCESS) + endif + connection=>this%get_connection() call connection%send(StageDoneMessage(),_RC) _RETURN(_SUCCESS) @@ -443,6 +455,10 @@ subroutine done_collective_stage(this, rc) class(AbstractSocket),pointer :: connection integer :: status + if (this%isEmpty_RequestHandle()) then + _RETURN(_SUCCESS) + endif + connection=>this%get_connection() call connection%send(CollectiveStageDoneMessage(),_RC) _RETURN(_SUCCESS) From e22ee67be412264609842931c5dbe0e3bfdd5d00 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 3 May 2024 13:25:24 -0400 Subject: [PATCH 03/61] Update to ESMA_cmake v3.45.1 --- CHANGELOG.md | 4 ++++ components.yaml | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bb095ae09e1a..757a80647b1d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Update `components.yaml` + - ESMA_cmake v3.45.1 + - Fix bug in meson detection + ### Fixed ### Removed diff --git a/components.yaml b/components.yaml index 94c80847201b..8db5c310f58b 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.45.0 + tag: v3.45.1 develop: develop ecbuild: From 220c2bfbeba7dfbfeb77bf3287827ad940a1c267 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 8 May 2024 10:28:30 -0400 Subject: [PATCH 04/61] Do not create file if not writing --- CHANGELOG.md | 1 + benchmarks/io/checkpoint_simulator/README.md | 6 +-- .../checkpoint_simulator.F90 | 40 +++++++++---------- 3 files changed, 24 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 757a80647b1d..77ec80229c15 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 - Update `components.yaml` - ESMA_cmake v3.45.1 - Fix bug in meson detection +- Updated `checkpoint_simulator` to not create and close file if not writing ### Fixed diff --git a/benchmarks/io/checkpoint_simulator/README.md b/benchmarks/io/checkpoint_simulator/README.md index d2cba319adc8..4466e69af71f 100644 --- a/benchmarks/io/checkpoint_simulator/README.md +++ b/benchmarks/io/checkpoint_simulator/README.md @@ -5,7 +5,7 @@ The code has the following options and needs an ESMF rc file named checkpoint\_b - "NX:" the x distribution for each face - "NY:" the y distribution for each face - "IM\_WORLD:" the cube resolution -- "LM:" the nubmer of levels +- "LM:" the number of levels - "NUM\_WRITERS:" the number of writing processes either to a single or independent files - "NUM\_ARRAYS:" the number of 3D variables to write to the file - "CHUNK:" whether to chunk, default true @@ -13,7 +13,7 @@ The code has the following options and needs an ESMF rc file named checkpoint\_b - "SPLIT\_FILE:" default false, if true, each writer writes to and independent file - "WRITE\_BARRIER:" default false, add a barrier before each write to for synchronization - "DO\_WRITES:" default true, if false skips writing (so just an mpi test at that point) -- "NTRIAL:" default 1, the number of trials to make writing +- "NTRIALS:" default 1, the number of trials to make writing - "RANDOM\_DATA:" default true, if true will arrays with random data, if false sets the array to the rank of the process -Note that whatever you set NX and NY to the program must be run on 6*NY*NY processors and the number of writers must evenly divide 6*NY +Note that whatever you set NX and NY to the program must be run on `6*NX*NY` processors and the number of writers must evenly divide `6*NY` diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index c82f395c3c11..d98d243b4839 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -55,7 +55,7 @@ module mapl_checkpoint_support_mod procedure :: write_level procedure :: write_variable procedure :: reset - end type + end type contains @@ -98,7 +98,7 @@ subroutine set_parameters(this,config_file) this%mpi_time = 0.0 call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,status) if (comm_size /= (this%nx*this%ny*6)) call MPI_Abort(mpi_comm_world,error_code,status) - + contains function get_logical_key(config,label,default_val) result(val) @@ -115,7 +115,7 @@ function get_logical_key(config,label,default_val) result(val) val = default_val end if end function - + function get_integer_key(config,label,default_val) result(val) integer :: val type(ESMF_Config), intent(Inout) :: config @@ -130,7 +130,7 @@ function get_integer_key(config,label,default_val) result(val) val = default_val end if end function - + end subroutine subroutine reset(this) @@ -144,7 +144,7 @@ subroutine reset(this) this%time_writing = 0.d0 this%mpi_time = 0.0 end subroutine - + function compute_decomposition(this,axis) result(decomp) integer, allocatable :: decomp(:) class(test_support), intent(inout) :: this @@ -172,7 +172,7 @@ subroutine allocate_n_arrays(this,im,jm) class(test_support), intent(inout) :: this integer, intent(in) :: im integer, intent(in) :: jm - + integer :: n,rank,status character(len=3) :: formatted_int integer :: seed_size @@ -201,7 +201,7 @@ subroutine create_arrays(this) integer, allocatable :: ims(:),jms(:) integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset - call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) allocate(this%bundle(this%num_arrays)) ims = this%compute_decomposition(axis=1) @@ -244,13 +244,13 @@ subroutine create_arrays(this) rank_counter = rank_counter + 1 enddo enddo - enddo - + enddo + end subroutine subroutine create_communicators(this) class(test_support), intent(inout) :: this - + integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key local_ny = this%ny*6 @@ -280,7 +280,7 @@ subroutine create_communicators(this) call MPI_BARRIER(mpi_comm_world,status) - + end subroutine subroutine close_file(this) @@ -344,7 +344,7 @@ subroutine create_file(this) status = nf90_def_dim(this%ncid,"lon",this%im_world,xdim) if (this%split_file) then y_size = this%im_world*6/this%num_writers - else + else y_size = this%im_world*6 end if status = nf90_def_dim(this%ncid,"lat",y_size,ydim) @@ -384,7 +384,7 @@ subroutine create_file(this) subroutine write_file(this) class(test_support), intent(inout) :: this integer :: status,i,l - + integer(kind=INT64) :: sub_start,sub_end call MPI_BARRIER(MPI_COMM_WORLD,status) @@ -619,7 +619,7 @@ subroutine write_level(this,var_name,local_var,z_index) io_time = end_time-start_time this%data_volume = this%data_volume+byte_to_mega*4.d0*size(var,kind=INT64) this%time_writing = this%time_writing + real(io_time,kind=REAL64)/real(count_rate,kind=REAL64) - + deallocate(VAR, stat=status) endif ! myiorank @@ -662,7 +662,7 @@ program checkpoint_tester call support%set_parameters("checkpoint_benchmark.rc") call MPI_Barrier(MPI_COMM_WORLD,status) - call support%create_arrays() + if (support%do_writes) call support%create_arrays() call MPI_Barrier(MPI_COMM_WORLD,status) call support%create_communicators() @@ -676,13 +676,13 @@ program checkpoint_tester call system_clock(count=start_write) call MPI_Barrier(MPI_COMM_WORLD,status) - call support%create_file() + if (support%do_writes) call support%create_file() call MPI_Barrier(MPI_COMM_WORLD,status) call support%write_file() call MPI_Barrier(MPI_COMM_WORLD,status) - call support%close_file() + if (support%do_writes) call support%close_file() call MPI_Barrier(MPI_COMM_WORLD,status) call system_clock(count=end_time) @@ -707,7 +707,7 @@ program checkpoint_tester all_proc_throughput(i) = real(support%num_writers,kind=REAL32)*average_volume/average_time end if enddo - + call system_clock(count=end_app) application_time = real(end_app - start_app,kind=REAL64)/real(count_rate,kind=REAL64) if (rank == 0) then @@ -741,7 +741,7 @@ program checkpoint_tester std_fs_throughput = sqrt(std_fs_throughput/real(support%n_trials,kind=REAL64)) write(*,'(G16.8,G16.8,G16.8,G16.8)')mean_throughput,std_throughput,mean_fs_throughput,std_fs_throughput end if - - + + call MPI_Finalize(status) end program From 68a0bd72ff69e2b80be665912e6d96ad82922740 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 9 May 2024 05:04:32 -0700 Subject: [PATCH 05/61] Fix bug. need to create arrays --- benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index d98d243b4839..f2d257c21020 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -662,7 +662,7 @@ program checkpoint_tester call support%set_parameters("checkpoint_benchmark.rc") call MPI_Barrier(MPI_COMM_WORLD,status) - if (support%do_writes) call support%create_arrays() + call support%create_arrays() call MPI_Barrier(MPI_COMM_WORLD,status) call support%create_communicators() From d585a1830de7763c3f06cd74cb03eb004c8c8283 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 9 May 2024 09:08:33 -0400 Subject: [PATCH 06/61] Add GNU UFS-Like CI test --- .circleci/config.yml | 2 +- CHANGELOG.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 1449faf89f25..b391e76ccb70 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -49,7 +49,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [ifort] + compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: MAPL mepodevelop: false diff --git a/CHANGELOG.md b/CHANGELOG.md index 757a80647b1d..1311ce4893f7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add GNU UFS-like CI test + ### Changed - Update `components.yaml` From fb53e28c29f66a1530dbe4bce59b2d515d768b12 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 10 May 2024 09:36:42 -0400 Subject: [PATCH 07/61] Fix up changelog --- CHANGELOG.md | 4 ---- 1 file changed, 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 243c4aa8baaf..7a355c1f4648 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,10 +11,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Update `components.yaml` - - ESMA_cmake v3.45.1 - - Fix bug in meson detection - ### Fixed ### Removed From a7fd2cd67aa4f8785194f12dfd2bc4db43de0752 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 10 May 2024 22:02:08 -0600 Subject: [PATCH 08/61] update --- gridcomps/History/MAPL_HistoryGridComp.F90 | 13 ++++++++++--- gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 | 8 ++++++-- .../History/Sampler/MAPL_TrajectoryMod_smod.F90 | 3 +-- 3 files changed, 17 insertions(+), 7 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index ccf3cc8b792a..adeae7854aa8 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2422,7 +2422,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%timeInfo = TimeData(clock,tm,MAPL_nsecf(list(n)%frequency),IntState%stampoffset(n),integer_time=intstate%integer_time) end if if (list(n)%timeseries_output) then - list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_RC) + list(n)%trajectory = HistoryTrajectory(cfg,string,clock,genstate=GENSTATE,_RC) + !!list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_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 @@ -3537,13 +3538,13 @@ subroutine Run ( gc, import, export, clock, rc ) lgr => logging%get_logger('HISTORY.sampler') if (list(n)%timeseries_output) then - call MAPL_TimerOn(GENSTATE,"TrajectoryRun") + !!call MAPL_TimerOn(GENSTATE,"TrajectoryRun") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then call list(n)%trajectory%create_file_handle(filename(n),_RC) list(n)%currentFile = filename(n) list(n)%unit = -1 end if - call MAPL_TimerOff(GENSTATE,"TrajectoryRun") + !!call MAPL_TimerOff(GENSTATE,"TrajectoryRun") elseif (list(n)%sampler_spec == 'station') then call MAPL_TimerOn(GENSTATE,"StationRun") if (list(n)%unit.eq.0) then @@ -3768,12 +3769,18 @@ subroutine Run ( gc, import, export, clock, rc ) if (list(n)%timeseries_output) then call MAPL_TimerOn(GENSTATE,"TrajectoryRun") + call MAPL_TimerOn(GENSTATE,"regrid_accum") call list(n)%trajectory%regrid_accumulate(_RC) + call MAPL_TimerOff(GENSTATE,"regrid_accum") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then + call MAPL_TimerOn(GENSTATE,"append_close_handle") call list(n)%trajectory%append_file(current_time,_RC) call list(n)%trajectory%close_file_handle(_RC) + call MAPL_TimerOff(GENSTATE,"append_close_handle") if ( .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then + call MAPL_TimerOn(GENSTATE,"destroy_reg_rh") call list(n)%trajectory%destroy_rh_regen_LS (_RC) + call MAPL_TimerOff(GENSTATE,"destroy_reg_rh") end if end if call MAPL_TimerOff(GENSTATE,"TrajectoryRun") diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 index 18f78e4e2d55..16ea19e574a1 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 @@ -7,6 +7,8 @@ module HistoryTrajectoryMod use LocStreamFactoryMod use MAPL_LocstreamRegridderMod use MAPL_ObsUtilMod + use MAPL_GenericMod, only : MAPL_MetaComp + use, intrinsic :: iso_fortran_env, only: REAL64 implicit none @@ -26,7 +28,8 @@ module HistoryTrajectoryMod real(kind=REAL64), allocatable :: times_R8(:) integer, allocatable :: obstype_id(:) integer, allocatable :: location_index_ioda(:) ! location index in its own ioda file - + type(MAPL_MetaComp), pointer :: GENSTATE + type(ESMF_FieldBundle) :: bundle type(ESMF_FieldBundle) :: output_bundle type(ESMF_FieldBundle) :: acc_bundle @@ -97,11 +100,12 @@ module HistoryTrajectoryMod interface - module function HistoryTrajectory_from_config(config,string,clock,rc) result(traj) + module function HistoryTrajectory_from_config(config,string,clock,GENSTATE,rc) result(traj) type(HistoryTrajectory) :: traj type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: string type(ESMF_Clock), intent(in) :: clock + type(MAPL_MetaComp), pointer, intent(in), optional :: GENSTATE integer, optional, intent(out) :: rc end function HistoryTrajectory_from_config diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 4185dc8e1573..1ca959172e5c 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -51,6 +51,7 @@ traj%clock=clock + if (present(GENSTATE)) traj%GENSTATE => GENSTATE call ESMF_ClockGet ( clock, CurrTime=currTime, _RC ) call ESMF_ConfigGetAttribute(config, value=time_integer, label=trim(string)//'Epoch:', default=0, _RC) _ASSERT(time_integer /= 0, 'Epoch value in config wrong') @@ -1105,7 +1106,6 @@ if (nx>0) then do ig = 1, this%obs(k)%ngeoval if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then - call lgr%debug('%a %a', 'append:2d inner put_var item%xname', trim(item%xname)) call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p2d(1:nx), & start=[is],count=[nx]) end if @@ -1173,7 +1173,6 @@ if (nx>0) then do ig = 1, this%obs(k)%ngeoval if (trim(item%xname) == trim(this%obs(k)%geoval_xname(ig))) then - call lgr%debug('%a %a', 'append:3d inner put_var item%xname', trim(item%xname)) call this%obs(k)%file_handle%put_var(trim(item%xname), this%obs(k)%p3d(:,:), & start=[is,1],count=[nx,size(p_acc_rt_3d,2)]) end if From c9975901a8225ac469a2389dc402fdd6e57b7264 Mon Sep 17 00:00:00 2001 From: Matt Thompson Date: Mon, 13 May 2024 15:19:14 -0400 Subject: [PATCH 09/61] Update CHANGELOG.md --- CHANGELOG.md | 3 --- 1 file changed, 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e139721f792c..5633f40a207e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,9 +11,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Update `components.yaml` - - ESMA_cmake v3.45.1 - - Fix bug in meson detection - Updated `checkpoint_simulator` to not create and close file if not writing ### Fixed From 0a4617da9e2ff971760f7d17e5e594b77219688e Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 14 May 2024 10:21:00 -0600 Subject: [PATCH 10/61] Add _FAIL to sub. fglob, if pathlen exceeds upper bound of filename length (ESMF_MAXSTR) --- CHANGELOG.md | 1 + base/MAPL_ObsUtil.F90 | 7 ++++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7a355c1f4648..a63c0e95f05a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Update `FindESMF.cmake` to match that in ESMF 8.6.1 +- If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob ### Changed diff --git a/base/MAPL_ObsUtil.F90 b/base/MAPL_ObsUtil.F90 index b5da6efa79d2..1b96fad92ae8 100644 --- a/base/MAPL_ObsUtil.F90 +++ b/base/MAPL_ObsUtil.F90 @@ -941,11 +941,16 @@ subroutine fglob(search_name, filename, rc) ! give the last name character(kind=C_CHAR, len=:), allocatable :: c_search_name character(kind=C_CHAR, len=512) :: c_filename - integer slen + integer :: slen, lenmax c_search_name = trim(search_name)//C_NULL_CHAR rc = f_call_c_glob(c_search_name, c_filename, slen) filename="" + lenmax = len(filename) + 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') + end if if (slen>0) filename(1:slen)=c_filename(1:slen) return From 4416719c6452cbe931605fd6a2b2bab52c0dd804 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 May 2024 09:15:21 -0600 Subject: [PATCH 11/61] update for timer --- gridcomps/History/MAPL_HistoryGridComp.F90 | 10 +++++----- gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index adeae7854aa8..a674e2dab2bf 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2423,7 +2423,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) - !!list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_RC) + !!list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_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 @@ -3546,7 +3546,7 @@ subroutine Run ( gc, import, export, clock, rc ) end if !!call MAPL_TimerOff(GENSTATE,"TrajectoryRun") elseif (list(n)%sampler_spec == 'station') then - call MAPL_TimerOn(GENSTATE,"StationRun") + call MAPL_TimerOn(GENSTATE,"Station_preRun") if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& "Station_data output to new file:",trim(filename(n))) @@ -3555,7 +3555,7 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 end if - call MAPL_TimerOff(GENSTATE,"StationRun") + call MAPL_TimerOff(GENSTATE,"Station_preRun") elseif (list(n)%sampler_spec == 'mask') then call MAPL_TimerOn(GENSTATE,"MaskRun") if (list(n)%unit.eq.0) then @@ -3771,12 +3771,12 @@ subroutine Run ( gc, import, export, clock, rc ) call MAPL_TimerOn(GENSTATE,"TrajectoryRun") call MAPL_TimerOn(GENSTATE,"regrid_accum") call list(n)%trajectory%regrid_accumulate(_RC) - call MAPL_TimerOff(GENSTATE,"regrid_accum") + call MAPL_TimerOff(GENSTATE,"regrid_accum") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then call MAPL_TimerOn(GENSTATE,"append_close_handle") call list(n)%trajectory%append_file(current_time,_RC) call list(n)%trajectory%close_file_handle(_RC) - call MAPL_TimerOff(GENSTATE,"append_close_handle") + call MAPL_TimerOff(GENSTATE,"append_close_handle") if ( .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then call MAPL_TimerOn(GENSTATE,"destroy_reg_rh") call list(n)%trajectory%destroy_rh_regen_LS (_RC) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 index 16ea19e574a1..d42d0bcbdf0a 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 @@ -8,7 +8,7 @@ module HistoryTrajectoryMod use MAPL_LocstreamRegridderMod use MAPL_ObsUtilMod use MAPL_GenericMod, only : MAPL_MetaComp - + use, intrinsic :: iso_fortran_env, only: REAL64 implicit none @@ -29,7 +29,7 @@ module HistoryTrajectoryMod integer, allocatable :: obstype_id(:) integer, allocatable :: location_index_ioda(:) ! location index in its own ioda file type(MAPL_MetaComp), pointer :: GENSTATE - + type(ESMF_FieldBundle) :: bundle type(ESMF_FieldBundle) :: output_bundle type(ESMF_FieldBundle) :: acc_bundle From 287f29468f1793f55d43d78fadad925545faf32f Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 May 2024 09:41:16 -0600 Subject: [PATCH 12/61] update --- gridcomps/History/MAPL_HistoryGridComp.F90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index a674e2dab2bf..135b982f1a67 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2423,7 +2423,6 @@ 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) - !!list(n)%trajectory = HistoryTrajectory(cfg,string,clock,_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 @@ -3526,7 +3525,7 @@ subroutine Run ( gc, import, export, clock, rc ) ! it's tempting to use the variable "oneMonth" but it does not work ! instead we compute the differece between ! thisMonth and lastMonth and as a new timeInterval - + ! call ESMF_ClockGet(clock,currTime=current_time,_RC) call ESMF_TimeIntervalSet( oneMonth, MM=1, _RC) lastMonth = current_time - oneMonth @@ -3538,13 +3537,11 @@ subroutine Run ( gc, import, export, clock, rc ) lgr => logging%get_logger('HISTORY.sampler') if (list(n)%timeseries_output) then - !!call MAPL_TimerOn(GENSTATE,"TrajectoryRun") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then call list(n)%trajectory%create_file_handle(filename(n),_RC) list(n)%currentFile = filename(n) list(n)%unit = -1 end if - !!call MAPL_TimerOff(GENSTATE,"TrajectoryRun") elseif (list(n)%sampler_spec == 'station') then call MAPL_TimerOn(GENSTATE,"Station_preRun") if (list(n)%unit.eq.0) then @@ -3557,7 +3554,6 @@ subroutine Run ( gc, import, export, clock, rc ) end if call MAPL_TimerOff(GENSTATE,"Station_preRun") elseif (list(n)%sampler_spec == 'mask') then - call MAPL_TimerOn(GENSTATE,"MaskRun") if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& "Mask_data output to new file:",trim(filename(n))) @@ -3566,7 +3562,6 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 end if - call MAPL_TimerOff(GENSTATE,"MaskRun") else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then From 98ffbf7e5584bc124d19def2855c464478005304 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 May 2024 09:57:40 -0600 Subject: [PATCH 13/61] Add changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 729f8d05e5c5..6ce301c5fcbb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -32,7 +32,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Update `FindESMF.cmake` to match that in ESMF 8.6.1 - +- Add timer to the sampler code ### Changed - Set required version of ESMF to 8.6.1 From e778e915203fedd8c390d1e20103bd0c189719c4 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 May 2024 23:02:23 -0600 Subject: [PATCH 14/61] Revision to station sampler --- gridcomps/History/MAPL_HistoryGridComp.F90 | 4 +- .../Sampler/MAPL_StationSamplerMod.F90 | 606 ++++++++++++------ 2 files changed, 418 insertions(+), 192 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 135b982f1a67..50b17a8d9c0d 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2429,8 +2429,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%mask_sampler = MaskSamplerGeosat(cfg,string,clock,_RC) call list(n)%mask_sampler%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) elseif (list(n)%sampler_spec == 'station') then - list(n)%station_sampler = StationSampler (trim(list(n)%stationIdFile), nskip_line=list(n)%stationSkipLine, _RC) - call list(n)%station_sampler%add_metadata_route_handle(list(n)%bundle,list(n)%timeInfo,vdata=list(n)%vdata,_RC) + list(n)%station_sampler = StationSampler (list(n)%bundle, trim(list(n)%stationIdFile), nskip_line=list(n)%stationSkipLine, _RC) + call list(n)%station_sampler%add_metadata_route_handle(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) else global_attributes = list(n)%global_atts%define_collection_attributes(_RC) if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 5257f94c375f..7e73b8a74d71 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -9,6 +9,8 @@ module StationSamplerMod use MAPL_BaseMod use MAPL_CommsMod use MAPL_LocstreamRegridderMod + use MPI, only : MPI_INTEGER, MPI_REAL, MPI_REAL8 + use, intrinsic :: iso_fortran_env, only: INT64 use, intrinsic :: iso_fortran_env, only: REAL32 use, intrinsic :: iso_fortran_env, only: REAL64 use, intrinsic :: iso_c_binding, only: C_NULL_CHAR @@ -19,8 +21,11 @@ module StationSamplerMod type :: StationSampler private type(LocStreamFactory) :: LSF - type(ESMF_LocStream) :: esmf_ls + type(ESMF_LocStream) :: LS_rt + type(ESMF_LocStream) :: LS_chunk + type(ESMF_LocStream) :: LS_ds type(LocstreamRegridder) :: regridder + type(ESMF_RouteHandle) :: RH integer :: nstation integer, allocatable :: station_id(:) character(len=ESMF_MAXSTR), allocatable :: station_name(:) @@ -29,7 +34,7 @@ module StationSamplerMod real(kind=REAL64), allocatable :: lats(:) real(kind=REAL64), allocatable :: elevs(:) type(ESMF_FieldBundle) :: bundle - type(FileMetadata) :: fmd + type(FileMetadata) :: metadata type(NetCDF4_FileFormatter) :: formatter type(VerticalData) :: vdata type(TimeData) :: time_info @@ -42,6 +47,7 @@ module StationSamplerMod procedure :: append_file procedure :: get_file_start_time procedure :: compute_time_for_current + procedure :: create_variable => create_metadata_variable end type StationSampler interface StationSampler @@ -50,14 +56,28 @@ module StationSamplerMod contains - function new_StationSampler_readfile (filename,nskip_line, rc) result(sampler) + function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(sampler) use pflogger, only : Logger, logging implicit none type(StationSampler) :: sampler + type(ESMF_FieldBundle), intent(in) :: bundle character(len=*), intent(in) :: filename - integer, optional, intent(in) :: nskip_line + integer, optional, intent(in) :: nskip_line integer, optional, intent(out) :: rc + type(ESMF_VM) :: vm + integer :: mypet, petcount, mpic + type(ESMF_grid) :: grid + integer, allocatable :: sendcount(:), displs(:) + integer :: recvcount + integer :: is, ie, ierr + integer :: M, N, ip + integer :: arr(1) + integer :: nx, nx2, nx_sum + + real(REAL64), allocatable :: lons_chunk(:) + real(REAL64), allocatable :: lats_chunk(:) + integer :: unit, ios, nstation, status integer :: i, j, k, ncount logical :: con1, con2 @@ -73,138 +93,202 @@ function new_StationSampler_readfile (filename,nskip_line, rc) result(sampler) ! ["name_short lat lon elev name_full"] ! - open(newunit=unit, file=trim(filename), form='formatted', & - access='sequential', status='old', _IOSTAT) - ios=0 - nstation=0 - nskip=0 - if (present(nskip_line)) then - nskip=nskip_line - end if - if (nskip>0) then - do i=1, nskip - read(unit, *) - end do - end if - read(unit, '(a100)', IOSTAT=ios) line - call count_substring(line, ',', ncount, _RC) - con1= (ncount>=2 .AND. ncount<=4).OR.(ncount==0) - _ASSERT(con1, 'string sequence in Aeronet file not supported') - if (ncount==0) then - seq='AFFFA' - elseif (ncount==2) then - seq='AFF' - elseif (ncount==3) then - seq='AFFF' - elseif (ncount==4) then - CH1=line(1:1) - con1= (CH1>='a'.AND.CH1<='z').OR.(CH1>='A'.AND.CH1<='Z') - con2= CH1>='0'.AND.CH1<='9' - if (con1) then - seq='AIFFF' - else - if (con2) then - seq='IAFFF' + if ( MAPL_AM_I_ROOT() ) then + open(newunit=unit, file=trim(filename), form='formatted', & + access='sequential', status='old', _IOSTAT) + ios=0 + nstation=0 + nskip=0 + if (present(nskip_line)) then + nskip=nskip_line + end if + if (nskip>0) then + do i=1, nskip + read(unit, *) + end do + end if + read(unit, '(a100)', IOSTAT=ios) line + call count_substring(line, ',', ncount, _RC) + con1= (ncount>=2 .AND. ncount<=4).OR.(ncount==0) + _ASSERT(con1, 'string sequence in Aeronet file not supported') + if (ncount==0) then + seq='AFFFA' + elseif (ncount==2) then + seq='AFF' + elseif (ncount==3) then + seq='AFFF' + elseif (ncount==4) then + CH1=line(1:1) + con1= (CH1>='a'.AND.CH1<='z').OR.(CH1>='A'.AND.CH1<='Z') + con2= CH1>='0'.AND.CH1<='9' + if (con1) then + seq='AIFFF' else - _ASSERT(.false., 'string sequence in Aeronet file not supported') + if (con2) then + seq='IAFFF' + else + _ASSERT(.false., 'string sequence in Aeronet file not supported') + end if end if end if - end if - rewind(unit) - if (nskip>0) then - do i=1, nskip - read(unit, *) + rewind(unit) + if (nskip>0) then + do i=1, nskip + read(unit, *) + end do + end if + ios=0 + do while (ios==0) + read(unit, '(a100)', IOSTAT=ios) line + if (ios==0) nstation=nstation+1 end do - end if - ios=0 - do while (ios==0) - read(unit, '(a100)', IOSTAT=ios) line - if (ios==0) nstation=nstation+1 - end do - sampler%nstation=nstation - allocate(sampler%station_id(nstation), _STAT) - allocate(sampler%station_name(nstation), _STAT) - allocate(sampler%station_fullname(nstation), _STAT) - allocate(sampler%lons(nstation), _STAT) - allocate(sampler%lats(nstation), _STAT) - allocate(sampler%elevs(nstation), _STAT) - - rewind(unit) - if (nskip>0) then - do i=1, nskip - read(unit, *) + sampler%nstation=nstation + allocate(sampler%station_id(nstation), _STAT) + allocate(sampler%station_name(nstation), _STAT) + allocate(sampler%station_fullname(nstation), _STAT) + allocate(sampler%lons(nstation), _STAT) + allocate(sampler%lats(nstation), _STAT) + allocate(sampler%elevs(nstation), _STAT) + + rewind(unit) + if (nskip>0) then + do i=1, nskip + read(unit, *) + end do + end if + do i=1, nstation + if(seq=='IAFFF') then + read(unit, *) & + sampler%station_id(i), & + sampler%station_name(i), & + sampler%lons(i), & + sampler%lats(i) + elseif(seq=='AIFFF') then + read(unit, *) & + sampler%station_name(i), & + sampler%station_id(i), & + sampler%lons(i), & + sampler%lats(i) + elseif(trim(seq)=='AFF' .OR. trim(seq)=='AFFF') then + !!write(6,*) 'i=', i + line='' + read(unit, '(a100)') line + !!write(6,*) 'line=', trim(line) + call CSV_read_line_with_CH_I_R(line, & + sampler%station_name(i), & + sampler%lons(i), & + sampler%lats(i), _RC) + sampler%station_id(i)=i + elseif(trim(seq)=='AFFFA') then + ! NOAA GHCNd + ! Ex: 'CHM00054511 39.9330 116.2830 55.0 BEIJING GSN 54511' + read(unit, *) & + sampler%station_name(i), & + sampler%lats(i), & + sampler%lons(i) + sampler%station_id(i)=i + backspace(unit) + read(unit, '(a100)', IOSTAT=ios) line + j=index(line, '.', BACK=.true.) + line2=line(j+1:) + k=len(line2) + line='' + do j=1, k + CH1=line2(j:j) + con1= (CH1>='a'.AND.CH1<='z').OR.(CH1>='A'.AND.CH1<='Z') + if (con1) exit + enddo + read(line2(j:k), '(a100)') line + line2=trim(line) + k=len(line2) + line='' + do j=1, k + CH1=line2(j:j) + con1= (CH1>='0' .AND. CH1<='9') + if (con1) exit + enddo + if (j>k) j=k + sampler%station_fullname(i) = trim(line2(1:j-1)) + end if end do + close(unit) + lgr => logging%get_logger('HISTORY.sampler') + call lgr%debug('%a %i8', 'nstation=', nstation) + call lgr%debug('%a %a %a', 'sampler%station_name(1:2) : ', & + trim(sampler%station_name(1)), trim(sampler%station_name(2))) + call lgr%debug('%a %f8.2 %f8.2', 'sampler%lons(1:2) : ',& + sampler%lons(1),sampler%lons(2)) + call lgr%debug('%a %f8.2 %f8.2', 'sampler%lats(1:2) : ',& + sampler%lats(1),sampler%lats(2)) + else + nstation=0 + allocate(sampler%station_id(nstation), _STAT) + allocate(sampler%station_name(nstation), _STAT) + allocate(sampler%station_fullname(nstation), _STAT) + allocate(sampler%lons(nstation), _STAT) + allocate(sampler%lats(nstation), _STAT) + allocate(sampler%elevs(nstation), _STAT) end if - do i=1, nstation - if(seq=='IAFFF') then - read(unit, *) & - sampler%station_id(i), & - sampler%station_name(i), & - sampler%lons(i), & - sampler%lats(i) - elseif(seq=='AIFFF') then - read(unit, *) & - sampler%station_name(i), & - sampler%station_id(i), & - sampler%lons(i), & - sampler%lats(i) - elseif(trim(seq)=='AFF' .OR. trim(seq)=='AFFF') then - !!write(6,*) 'i=', i - line='' - read(unit, '(a100)') line - !!write(6,*) 'line=', trim(line) - call CSV_read_line_with_CH_I_R(line, & - sampler%station_name(i), & - sampler%lons(i), & - sampler%lats(i), _RC) - sampler%station_id(i)=i - elseif(trim(seq)=='AFFFA') then - ! NOAA GHCNd - ! Ex: 'CHM00054511 39.9330 116.2830 55.0 BEIJING GSN 54511' - read(unit, *) & - sampler%station_name(i), & - sampler%lats(i), & - sampler%lons(i) - sampler%station_id(i)=i - backspace(unit) - read(unit, '(a100)', IOSTAT=ios) line - j=index(line, '.', BACK=.true.) - line2=line(j+1:) - k=len(line2) - line='' - do j=1, k - CH1=line2(j:j) - con1= (CH1>='a'.AND.CH1<='z').OR.(CH1>='A'.AND.CH1<='Z') - if (con1) exit - enddo - read(line2(j:k), '(a100)') line - line2=trim(line) - k=len(line2) - line='' - do j=1, k - CH1=line2(j:j) - con1= (CH1>='0' .AND. CH1<='9') - if (con1) exit - enddo - if (j>k) j=k - sampler%station_fullname(i) = trim(line2(1:j-1)) - end if - end do - close(unit) - lgr => logging%get_logger('HISTORY.sampler') - call lgr%debug('%a %i8', 'nstation=', nstation) - call lgr%debug('%a %a %a', 'sampler%station_name(1:2) : ', & - trim(sampler%station_name(1)), trim(sampler%station_name(2))) - call lgr%debug('%a %f8.2 %f8.2', 'sampler%lons(1:2) : ',& - sampler%lons(1),sampler%lons(2)) - call lgr%debug('%a %f8.2 %f8.2', 'sampler%lats(1:2) : ',& - sampler%lats(1),sampler%lats(2)) - - !__ 2. create LocStreamFactory, then esmf_ls including route_handle + + + !__ 2. create LocStreamFactory, then LS_rt including route_handle ! - sampler%LSF = LocStreamFactory(sampler%lons, sampler%lats, _RC) - sampler%esmf_ls = sampler%LSF%create_locstream(_RC) + ! grid_A: LS_rt : on root + ! grid_B: LS_chunk : uniform on cores + ! grid_C: LS_ds : bg=CS + ! + call ESMF_VMGetCurrent(vm,_RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petCount=petCount, localPet=mypet, _RC) + call MAPL_CommsBcast(vm, DATA=sampler%nstation, N=1, ROOT=MAPL_Root, _RC) + + nx_sum = sampler%nstation + ip = mypet ! 0 to M-1 + N = nx_sum + M = petCount + recvcount = int(ip+1, INT64) * int(N, INT64) / int(M, INT64) - & + int(ip , INT64) * int(N, INT64) / int(M, INT64) + call lgr%debug('%a %i12 %i12', 'ip, recvcount', ip, recvcount) + + allocate ( sendcount (petCount) ) + allocate ( displs (petCount) ) + do ip=0, M-1 + sendcount(ip+1) = int(ip+1, INT64) * int(N, INT64) / int(M, INT64) - & + int(ip , INT64) * int(N, INT64) / int(M, INT64) + end do + displs(1)=0 + do i = 2, petCount + displs(i) = displs(i-1) + sendcount(i-1) + end do + + allocate ( lons_chunk (recvcount) ) + allocate ( lats_chunk (recvcount) ) + + arr(1) = recvcount + call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx2, & + count=1, reduceflag=ESMF_REDUCE_SUM, rc=rc) + _ASSERT( nx2 == nx_sum, 'Erorr in recvcount' ) + + call MPI_Scatterv( sampler%lons, sendcount, & + displs, MPI_REAL8, lons_chunk, & + recvcount, MPI_REAL8, 0, mpic, ierr) + + call MPI_Scatterv( sampler%lats, sendcount, & + displs, MPI_REAL8, lats_chunk, & + recvcount, MPI_REAL8, 0, mpic, ierr) + + ! -- root + sampler%LSF = LocStreamFactory(sampler%lons, sampler%lats, _RC) + sampler%LS_rt = sampler%LSF%create_locstream(_RC) + + ! -- chunk + sampler%LSF = LocStreamFactory(lons_chunk,lats_chunk,_RC) + sampler%LS_chunk = sampler%LSF%create_locstream_on_proc(_RC) + + ! -- distributed + call ESMF_FieldBundleGet(bundle,grid=grid,_RC) + sampler%LS_ds = sampler%LSF%create_locstream_on_proc(grid=grid,_RC) + ! ! init ofile sampler%ofile='' @@ -214,10 +298,11 @@ function new_StationSampler_readfile (filename,nskip_line, rc) result(sampler) end function new_StationSampler_readfile - subroutine add_metadata_route_handle (this,bundle,timeInfo,vdata,rc) + subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) class(StationSampler), intent(inout) :: this - type(ESMF_FieldBundle), intent(in) :: bundle - type(TimeData), intent(inout) :: timeInfo + type(GriddedIOitemVector), optional, intent(inout) :: items + type(ESMF_FieldBundle), optional, intent(inout) :: bundle + type(TimeData), optional, intent(inout) :: timeInfo type(VerticalData), optional, intent(inout) :: vdata integer, optional, intent(out) :: rc @@ -237,6 +322,9 @@ subroutine add_metadata_route_handle (this,bundle,timeInfo,vdata,rc) character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: var_name, long_name, units, vdims + type(ESMF_Field) :: src_field, chunk_field + real(REAL32), pointer :: pt1(:), pt2(:) + !__ 1. metadata add_dimension, ! add_variable for time, latlon, station ! @@ -247,81 +335,123 @@ subroutine add_metadata_route_handle (this,bundle,timeInfo,vdata,rc) else this%vdata = VerticalData(_RC) end if - call this%vdata%append_vertical_metadata(this%fmd,this%bundle,_RC) ! specify lev in fmd + call this%vdata%append_vertical_metadata(this%metadata,this%bundle,_RC) ! specify lev in fmd do_vertical_regrid = (this%vdata%regrid_type /= VERTICAL_METHOD_NONE) if (this%vdata%regrid_type == VERTICAL_METHOD_ETA2LEV) then call this%vdata%get_interpolating_variable(this%bundle,_RC) endif - call timeInfo%add_time_to_metadata(this%fmd,_RC) ! specify time in fmd + call timeInfo%add_time_to_metadata(this%metadata,_RC) ! specify time in fmd this%time_info = timeInfo - call this%fmd%add_dimension('station_index',nstation) + call this%metadata%add_dimension('station_index',nstation) v = Variable(type=pFIO_REAL32, dimensions='station_index') call v%add_attribute('long_name','longitude') call v%add_attribute('unit','degree_east') - call this%fmd%add_variable('longitude',v) + call this%metadata%add_variable('longitude',v) v = Variable(type=pFIO_REAL32, dimensions='station_index') call v%add_attribute('long_name','latitude') call v%add_attribute('unit','degree_north') - call this%fmd%add_variable('latitude',v) + call this%metadata%add_variable('latitude',v) v = Variable(type=pFIO_INT32, dimensions='station_index') - call this%fmd%add_variable('station_id',v) + call this%metadata%add_variable('station_id',v) v = Variable(type=pFIO_STRING, dimensions='station_index') call v%add_attribute('long_name','station name') - call this%fmd%add_variable('station_name',v) + call this%metadata%add_variable('station_name',v) - !__ 2. filemetadata: extract field from bundle, add_variable + !__ 2. filemetadata: + ! create varible with names in metadata; see create_metadata_variable ! - call ESMF_FieldBundleGet(bundle, fieldCount=fieldCount, _RC) - allocate (fieldNameList(fieldCount), _STAT) - call ESMF_FieldBundleGet(bundle, fieldNameList=fieldNameList, _RC) - do i=1, fieldCount - var_name=trim(fieldNameList(i)) - call ESMF_FieldBundleGet(bundle,var_name,field=field,_RC) - call ESMF_FieldGet(field,rank=field_rank,_RC) - call ESMF_AttributeGet(field,name="LONG_NAME",isPresent=is_present,_RC) - if ( is_present ) then - call ESMF_AttributeGet(field, NAME="LONG_NAME",VALUE=long_name, _RC) - else - long_name = var_name - endif - call ESMF_AttributeGet(field,name="UNITS",isPresent=is_present,_RC) - if ( is_present ) then - call ESMF_AttributeGet(field, NAME="UNITS",VALUE=units, _RC) - else - units = 'unknown' - endif - if (field_rank==2) then - vdims = "station_index,time" - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[nstation,1]) - else if (field_rank==3) then - vdims = "lev,station_index,time" - call ESMF_FieldGet(field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[ub(1)-lb(1)+1,1,1]) + iter = this%items%begin() + do while (iter /= this%items%end()) + item => iter%get() +!! print*, 'list item%xname', trim(item%xname) + if (item%itemType == ItemTypeScalar) then + call this%create_variable(item%xname,_RC) + else if (item%itemType == ItemTypeVector) then + call this%create_variable(item%xname,_RC) + call this%create_variable(item%yname,_RC) end if - call v%add_attribute('units', trim(units)) - call v%add_attribute('long_name', trim(long_name)) - call v%add_attribute('missing_value', MAPL_UNDEF) - call v%add_attribute('_FillValue', MAPL_UNDEF) - call v%add_attribute('valid_range', (/-MAPL_UNDEF,MAPL_UNDEF/)) - call this%fmd%add_variable(trim(var_name),v,_RC) - end do - deallocate (fieldNameList) + call iter%next() + enddo - !__ 3. locstream route handle + !__ 3. route handle CS --> LS_ds ! call ESMF_FieldBundleGet(bundle,grid=grid,_RC) - this%regridder = LocStreamRegridder(grid,this%esmf_ls,_RC) + this%regridder = LocStreamRegridder(grid,this%LS_ds,_RC) + + !__ 4. route handle LS_ds --> LS_chunk + ! + src_field = ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4,gridToFieldMap=[1],_RC) + chunk_field = ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4,gridToFieldMap=[1],_RC) + call ESMF_FieldGet( src_field, localDE=0, farrayPtr=pt1, _RC ) + call ESMF_FieldGet( chunk_field, localDE=0, farrayPtr=pt2, _RC ) + pt1=0.0 + pt2=0.0 + call ESMF_FieldRedistStore(src_field,chunk_field,this%RH,_RC) + call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) + call ESMF_FieldDestroy(chunk_field,noGarbage=.true.,_RC) + + _RETURN(_SUCCESS) + end subroutine add_metadata_route_handle + + + subroutine create_metadata_variable(this,vname,rc) + class(HistoryTrajectory), intent(inout) :: this + character(len=*), intent(in) :: vname + integer, optional, intent(out) :: rc + + type(ESMF_Field) :: field + type(variable) :: v + logical :: is_present + integer :: field_rank, status + character(len=ESMF_MAXSTR) :: var_name,long_name,units,vdims + integer :: k, ig + + call ESMF_FieldBundleGet(this%bundle,vname,field=field,_RC) + call ESMF_FieldGet(field,name=var_name,rank=field_rank,_RC) + call ESMF_AttributeGet(field,name="LONG_NAME",isPresent=is_present,_RC) + if ( is_present ) then + call ESMF_AttributeGet (FIELD, NAME="LONG_NAME",VALUE=long_name, _RC) + else + long_name = var_name + endif + call ESMF_AttributeGet(field,name="UNITS",isPresent=is_present,_RC) + if ( is_present ) then + call ESMF_AttributeGet (FIELD, NAME="UNITS",VALUE=units, _RC) + else + units = 'unknown' + endif + if (field_rank==2) then + vdims = this%index_name_x + else if (field_rank==3) then + vdims = trim(this%index_name_x)//",lev" + end if + if (field_rank==2) then + vdims = "station_index,time" + v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[nstation,1]) + else if (field_rank==3) then + vdims = "lev,station_index,time" + call ESMF_FieldGet(field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) + v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[ub(1)-lb(1)+1,1,1]) + end if + + call v%add_attribute('units',trim(units)) + call v%add_attribute('long_name',trim(long_name)) + call v%add_attribute('missing_value',MAPL_UNDEF) + call v%add_attribute('_FillValue',MAPL_UNDEF) + call v%add_attribute('valid_range',(/-MAPL_UNDEF,MAPL_UNDEF/)) + call this%metadata%add_variable(trim(var_name),v,_RC) _RETURN(_SUCCESS) - end subroutine add_metadata_route_handle + end subroutine create_metadata_variable + subroutine append_file(this,current_time,rc) @@ -342,8 +472,25 @@ subroutine append_file(this,current_time,rc) integer :: i, rank integer :: nx, nz + type(ESMF_VM) :: vm + integer :: mypet, petcount, mpic + integer :: nx, nx_sum + integer :: n0 + integer :: arr(1) + integer :: sec + integer, allocatable :: ix(:) ! counter for each obs(k)%nobs_epoch + integer :: nx2 + logical :: EX ! file + logical :: zero_obs + integer, allocatable :: sendcount(:), displs(:) + integer :: recvcount + integer :: is, ie, ierr + integer :: M, N, ip + + this%obs_written=this%obs_written+1 + !__ 1. put_var: time variable ! rtimes = this%compute_time_for_current(current_time,_RC) ! rtimes: seconds since opening file @@ -355,26 +502,75 @@ subroutine append_file(this,current_time,rc) start=[this%obs_written],count=[1],_RC) end if - !__ 2. put_var: ungridded_dim from src to dst [regrid] + + !__ 2. regrid + put_var: ungridded_dim from src to dst [regrid] ! - call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) - allocate (fieldNameList(fieldCount), _STAT) - call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) - do i=1, fieldCount - xname=trim(fieldNameList(i)) - call ESMF_FieldBundleGet(this%bundle,xname,field=src_field,_RC) + + lm = this%vdata%lm + field_2d_rt = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) + field_3d_rt = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + + field_2d_chunk = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) + field_3d_chunk = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + + ! caution about zero-sized array for MPI + ! redist + nx_sum = this%nstation + call ESMF_VMGetCurrent(vm,_RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petCount=petCount, localPet=mypet, _RC) + + iroot = 0 + ip = mypet + N = nx_sum + M = petCount + nsend = int(ip+1, INT64) * int(N, INT64) / int(M, INT64) - & + int(ip , INT64) * int(N, INT64) / int(M, INT64) + allocate ( recvcount (petCount) ) + allocate ( displs (petCount) ) + do ip=0, M-1 + recvcount(ip+1) = int(ip+1, INT64) * int(N, INT64) / int(M, INT64) - & + int(ip , INT64) * int(N, INT64) / int(M, INT64) + end do + displs(1)=0 + do i = 2, petCount + displs(i) = displs(i-1) + recvcount(i-1) + end do + + nsend_v = nsend * lm ! vertical + allocate (recvcount_v, source = recvcount * lm ) + allocate (displs_v, source = displs * lm ) + + + iter = this%items%begin() + do while (iter /= this%items%end()) + item => iter%get() + 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) if (rank==2) then call ESMF_FieldGet(src_field,farrayptr=p_src_2d,_RC) - dst_field = ESMF_FieldCreate(this%esmf_ls,name=xname, & + dst_field = ESMF_FieldCreate(this%LS_ds,name=xname, & typekind=ESMF_TYPEKIND_R4,_RC) call ESMF_FieldGet(dst_field,farrayptr=p_dst_2d,_RC) call this%regridder%regrid(p_src_2d,p_dst_2d,_RC) + + call ESMF_FieldGet(field_2d_chunk, localDE=0, farrayPtr=p_chunk_2d, _RC ) + call ESMF_FieldRedist(dst_field, field_2d_chunk, this%RH, _RC ) + call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & + p_rt_2d, recvcount, displs, MPI_REAL,& + iroot, mpic, ierr ) + if (mapl_am_i_root()) then - call this%formatter%put_var(xname,p_dst_2d,& + call this%formatter%put_var(xname,p_rt_2d,& start=[1,this%obs_written],count=[this%nstation,1],_RC) end if + call ESMF_FieldDestroy(dst_field,nogarbage=.true.) + else if (rank==3) then call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) @@ -382,10 +578,15 @@ subroutine append_file(this,current_time,rc) lb(1)=1 ub(1)=this%vdata%lm end if - dst_field = ESMF_FieldCreate(this%esmf_ls,name=xname,& + dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + + call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) + p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) + call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) + if (mapl_am_i_root()) then nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) @@ -399,7 +600,31 @@ subroutine append_file(this,current_time,rc) _FAIL('grid2LS regridder: rank > 3 not implemented') end if end do - deallocate (fieldNameList) + + + + call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) + call ESMF_FieldGet(src_field,rank=rank,_RC) + if (rank==1) then + call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_2d, _RC ) + call ESMF_FieldGet( acc_field_2d_chunk, localDE=0, farrayPtr=p_acc_chunk_2d, _RC ) + call ESMF_FieldRedist( acc_field, acc_field_2d_chunk, RH, _RC ) + call MPI_gatherv ( p_acc_chunk_2d, nsend, MPI_REAL, & + p_acc_rt_2d, recvcount, displs, MPI_REAL,& + iroot, mpic, ierr ) + + + + + + call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) + allocate (fieldNameList(fieldCount), _STAT) + call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) + do i=1, fieldCount + xname=trim(fieldNameList(i)) + + + deallocate (fieldNameList) _RETURN(_SUCCESS) end subroutine append_file @@ -413,14 +638,14 @@ subroutine create_file_handle(this,filename,rc) this%ofile = trim(filename) v = this%time_info%define_time_variable(_RC) - call this%fmd%modify_variable('time',v,_RC) + call this%metadata%modify_variable('time',v,_RC) this%obs_written = 0 if (.not. mapl_am_I_root()) then _RETURN(_SUCCESS) end if call this%formatter%create(trim(filename),_RC) - call this%formatter%write(this%fmd,_RC) + call this%formatter%write(this%metadata,_RC) call this%formatter%put_var('longitude',this%lons,_RC) call this%formatter%put_var('latitude',this%lats,_RC) call this%formatter%put_var('station_id',this%station_id,_RC) @@ -491,7 +716,7 @@ subroutine get_file_start_time(this,start_time,time_units,rc) integer lastspace,since_pos integer year,month,day,hour,min,sec - var => this%fmd%get_variable('time',_RC) + var => this%metadata%get_variable('time',_RC) attr => var%get_attribute('units') ptimeUnits => attr%get_value() select type(pTimeUnits) @@ -570,6 +795,7 @@ subroutine get_file_start_time(this,start_time,time_units,rc) _RETURN(_SUCCESS) end subroutine get_file_start_time + ! TODO: delete and use system utilities when available Subroutine count_substring (str, t, ncount, rc) character (len=*), intent(in) :: str From a19b9126e7be7f12121d11944de3d597f611f426 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 17 May 2024 08:27:11 -0600 Subject: [PATCH 15/61] update --- .../Sampler/MAPL_StationSamplerMod.F90 | 110 +++++++++++++++--- 1 file changed, 92 insertions(+), 18 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 7e73b8a74d71..bdcc72031f68 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -464,7 +464,10 @@ subroutine append_file(this,current_time,rc) integer :: ub(1), lb(1) type(ESMF_Field) :: src_field,dst_field real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:) - real(kind=REAL32), pointer :: p_dst_3d(:,:),p_dst_2d(:) + real(kind=REAL32), pointer :: p_ds_3d(:,:),p_ds_2d(:) + real(kind=REAL32), pointer :: p_chunk_3d(:,:),p_chunk_2d(:) + real(kind=REAL32), pointer :: p_rt_3d(:,:),p_rt_2d(:) + real(kind=REAL32), allocatable :: arr(:,:) character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: xname @@ -494,9 +497,6 @@ subroutine append_file(this,current_time,rc) !__ 1. put_var: time variable ! rtimes = this%compute_time_for_current(current_time,_RC) ! rtimes: seconds since opening file - if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then - call this%vdata%setup_eta_to_pressure(_RC) - end if if (mapl_am_i_root()) then call this%formatter%put_var('time',rtimes(1:1),& start=[this%obs_written],count=[1],_RC) @@ -507,14 +507,16 @@ subroutine append_file(this,current_time,rc) ! lm = this%vdata%lm - field_2d_rt = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) - field_3d_rt = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & + field_ds_2d = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) + field_ds_3d = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - field_2d_chunk = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) - field_3d_chunk = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & + field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) + field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - + + + ! caution about zero-sized array for MPI ! redist nx_sum = this%nstation @@ -542,24 +544,43 @@ subroutine append_file(this,current_time,rc) allocate (recvcount_v, source = recvcount * lm ) allocate (displs_v, source = displs * lm ) + if (mapl_am_i_root()) then + allocate ( p_rt_2d(nx_sum) ) + else + allocate ( p_rt_2d(1) ) + end if +! ! +! ! p_dst (lm, nx) +! if (mapl_am_i_root()) then +! allocate ( p_acc_rt_3d(nx_sum,lm) ) +! allocate ( p_dst_rt(lm, nx_sum) ) +! else +! allocate ( p_acc_rt_3d(1,lm) ) +! allocate ( p_dst_rt(lm, 1) ) +! end if + + ! + ! reuse + ! the pointers p_ds_2d, p_ds_3d, in field_ds_2d, field_ds_3d + ! the pointers p_chunk_2d, p_chunk_3d in field_chunk_2d, field_chunk_3d + ! gather to p_rt_2d, p_rt_3d + ! iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() 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) if (rank==2) then call ESMF_FieldGet(src_field,farrayptr=p_src_2d,_RC) - dst_field = ESMF_FieldCreate(this%LS_ds,name=xname, & - typekind=ESMF_TYPEKIND_R4,_RC) - call ESMF_FieldGet(dst_field,farrayptr=p_dst_2d,_RC) - call this%regridder%regrid(p_src_2d,p_dst_2d,_RC) + call ESMF_FieldGet(field_ds_2d,farrayptr=p_ds_2d,_RC) + call ESMF_FieldGet(field_chunk_2d,farrayPtr=p_chunk_2d,_RC) + call ESMF_FieldGet(field_rt_2d,farrayPtr=p_rt_2d,_RC) - call ESMF_FieldGet(field_2d_chunk, localDE=0, farrayPtr=p_chunk_2d, _RC ) - call ESMF_FieldRedist(dst_field, field_2d_chunk, this%RH, _RC ) + call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) + call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & p_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) @@ -569,10 +590,61 @@ subroutine append_file(this,current_time,rc) start=[1,this%obs_written],count=[this%nstation,1],_RC) end if - call ESMF_FieldDestroy(dst_field,nogarbage=.true.) - else if (rank==3) then + ! -- regrid + ! -- LS ds->chunk + ! -- chunk->rt + ! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) + call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) + call ESMF_FieldGet(acc_field,farrayptr=p_acc_3d,_RC) + if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then + allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) + call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) + call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) + if (is > 0 .AND. is <= ie ) then + p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) + end if + else + call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + if (is > 0 .AND. is <= ie ) then + p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) + end if + end if + + + call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) + dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + + call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) + call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) + p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) + call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) + + if (this%level_by_level) then + ! p_dst (lm, nx) + allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) + do k = 1, lm + call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & + p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& + iroot, mpic, ierr ) + end do + deallocate (p_dst_t) + else + call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & + p_dst_rt, recvcount_v, displs_v, MPI_REAL,& + iroot, mpic, ierr ) + p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) + end if + + call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) + call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) + + + call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) if (this%vdata%lm/=(ub(1)-lb(1)+1)) then lb(1)=1 @@ -596,6 +668,8 @@ subroutine append_file(this,current_time,rc) deallocate(arr) end if call ESMF_FieldDestroy(dst_field,nogarbage=.true.) + + else _FAIL('grid2LS regridder: rank > 3 not implemented') end if From b7e0b0fa8fcd26479e263fd3bebcb6c724c2cd20 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 17 May 2024 09:48:42 -0600 Subject: [PATCH 16/61] Reformat timer for samplers --- gridcomps/History/MAPL_HistoryGridComp.F90 | 40 ++++++++++------------ 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 135b982f1a67..998e13d4f8f4 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3451,11 +3451,13 @@ subroutine Run ( gc, import, export, clock, rc ) ! swath only epoch_swath_grid_case: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) - call MAPL_TimerOn(GENSTATE,"SwathRun") if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then + call MAPL_TimerOn(GENSTATE,"RegridAccum") call Hsampler%regrid_accumulate(list(n)%xsampler,_RC) + call MAPL_TimerOff(GENSTATE,"RegridAccum") if( ESMF_AlarmIsRinging ( Hsampler%alarm ) ) then + call MAPL_TimerOn(GENSTATE,"RegenGriddedio") create_mode = PFIO_NOCLOBBER ! defaut no overwrite if (intState%allow_overwrite) create_mode = PFIO_CLOBBER ! add time to items @@ -3473,12 +3475,12 @@ subroutine Run ( gc, import, export, clock, rc ) call list(n)%mGriddedIO%destroy(_RC) call list(n)%mGriddedIO%CreateFileMetaData(list(n)%items,list(n)%xsampler%acc_bundle,timeinfo_uninit,vdata=list(n)%vdata,global_attributes=global_attributes,_RC) call list(n)%items%pop_back() - collection_id = o_Clients%add_hist_collection(list(n)%mGriddedIO%metadata, mode = create_mode) call list(n)%mGriddedIO%set_param(write_collection_id=collection_id) + call MAPL_TimerOff(GENSTATE,"RegenGriddedio") endif + end if - call MAPL_TimerOff(GENSTATE,"SwathRun") call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_grid_case @@ -3543,7 +3545,6 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%unit = -1 end if elseif (list(n)%sampler_spec == 'station') then - call MAPL_TimerOn(GENSTATE,"Station_preRun") if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& "Station_data output to new file:",trim(filename(n))) @@ -3552,7 +3553,6 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 end if - call MAPL_TimerOff(GENSTATE,"Station_preRun") elseif (list(n)%sampler_spec == 'mask') then if (list(n)%unit.eq.0) then call lgr%debug('%a %a',& @@ -3694,18 +3694,20 @@ subroutine Run ( gc, import, export, clock, rc ) end if IOTYPE end if + if (list(n)%sampler_spec == 'station') then - call MAPL_TimerOn(GENSTATE,"StationRun") call ESMF_ClockGet(clock,currTime=current_time,_RC) + call MAPL_TimerOn(GENSTATE,"AppendFile") call list(n)%station_sampler%append_file(current_time,_RC) - call MAPL_TimerOff(GENSTATE,"StationRun") + call MAPL_TimerOff(GENSTATE,"AppendFile") elseif (list(n)%sampler_spec == 'mask') then - call MAPL_TimerOn(GENSTATE,"MaskRun") call ESMF_ClockGet(clock,currTime=current_time,_RC) + call MAPL_TimerOn(GENSTATE,"AppendFile") call list(n)%mask_sampler%append_file(current_time,_RC) - call MAPL_TimerOff(GENSTATE,"MaskRun") + call MAPL_TimerOff(GENSTATE,"AppendFile") endif + endif OUTTIME if( NewSeg(n) .and. list(n)%unit /= 0 .and. list(n)%duration /= 0 ) then @@ -3732,18 +3734,16 @@ subroutine Run ( gc, import, export, clock, rc ) epoch_swath_regen_grid: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then - call MAPL_TimerOn(GENSTATE,"SwathRun") if( ESMF_AlarmIsRinging ( Hsampler%alarm ) .and. .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then - + call MAPL_TimerOn(GENSTATE,"RegenGrid") key_grid_label = list(n)%output_grid_label call Hsampler%destroy_rh_regen_ogrid ( key_grid_label, IntState%output_grids, list(n)%xsampler, _RC ) - pgrid => IntState%output_grids%at(trim(list(n)%output_grid_label)) call list(n)%xsampler%Create_bundle_RH(list(n)%items,list(n)%bundle,Hsampler%tunit, & ogrid=pgrid,vdata=list(n)%vdata,_RC) if( MAPL_AM_I_ROOT() ) write(6,'(//)') + call MAPL_TimerOff(GENSTATE,"RegenGrid") endif - call MAPL_TimerOff(GENSTATE,"SwathRun") end if call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_regen_grid @@ -3763,22 +3763,20 @@ subroutine Run ( gc, import, export, clock, rc ) call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) if (list(n)%timeseries_output) then - call MAPL_TimerOn(GENSTATE,"TrajectoryRun") - call MAPL_TimerOn(GENSTATE,"regrid_accum") + call MAPL_TimerOn(GENSTATE,"RegridAccum") call list(n)%trajectory%regrid_accumulate(_RC) - call MAPL_TimerOff(GENSTATE,"regrid_accum") + call MAPL_TimerOff(GENSTATE,"RegridAccum") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then - call MAPL_TimerOn(GENSTATE,"append_close_handle") + call MAPL_TimerOn(GENSTATE,"AppendFile") call list(n)%trajectory%append_file(current_time,_RC) call list(n)%trajectory%close_file_handle(_RC) - call MAPL_TimerOff(GENSTATE,"append_close_handle") + call MAPL_TimerOff(GENSTATE,"AppendFile") if ( .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then - call MAPL_TimerOn(GENSTATE,"destroy_reg_rh") + call MAPL_TimerOn(GENSTATE,"RegenLS") call list(n)%trajectory%destroy_rh_regen_LS (_RC) - call MAPL_TimerOff(GENSTATE,"destroy_reg_rh") + call MAPL_TimerOff(GENSTATE,"RegenLS") end if end if - call MAPL_TimerOff(GENSTATE,"TrajectoryRun") end if if( Writing(n) .and. list(n)%unit < 0) then From 68123442e1a36bcb4a7fcca104a356ae18c5fff6 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 17 May 2024 10:48:44 -0600 Subject: [PATCH 17/61] add explicit names swath/station etc. to timers --- gridcomps/History/MAPL_HistoryGridComp.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 998e13d4f8f4..6b8610352a52 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3452,6 +3452,7 @@ subroutine Run ( gc, import, export, clock, rc ) epoch_swath_grid_case: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then + call MAPL_TimerOn(GENSTATE,"Swath") call MAPL_TimerOn(GENSTATE,"RegridAccum") call Hsampler%regrid_accumulate(list(n)%xsampler,_RC) call MAPL_TimerOff(GENSTATE,"RegridAccum") @@ -3479,8 +3480,9 @@ subroutine Run ( gc, import, export, clock, rc ) call list(n)%mGriddedIO%set_param(write_collection_id=collection_id) call MAPL_TimerOff(GENSTATE,"RegenGriddedio") endif - + call MAPL_TimerOff(GENSTATE,"Swath") end if + call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_grid_case @@ -3697,14 +3699,18 @@ subroutine Run ( gc, import, export, clock, rc ) if (list(n)%sampler_spec == 'station') then call ESMF_ClockGet(clock,currTime=current_time,_RC) + call MAPL_TimerOn(GENSTATE,"Station") call MAPL_TimerOn(GENSTATE,"AppendFile") call list(n)%station_sampler%append_file(current_time,_RC) call MAPL_TimerOff(GENSTATE,"AppendFile") + call MAPL_TimerOff(GENSTATE,"Station") elseif (list(n)%sampler_spec == 'mask') then call ESMF_ClockGet(clock,currTime=current_time,_RC) + call MAPL_TimerOn(GENSTATE,"Mask") call MAPL_TimerOn(GENSTATE,"AppendFile") call list(n)%mask_sampler%append_file(current_time,_RC) call MAPL_TimerOff(GENSTATE,"AppendFile") + call MAPL_TimerOff(GENSTATE,"Mask") endif @@ -3734,6 +3740,7 @@ subroutine Run ( gc, import, export, clock, rc ) epoch_swath_regen_grid: do n=1,nlist call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) if (index(trim(list(n)%output_grid_label), 'SwathGrid') > 0) then + call MAPL_TimerOn(GENSTATE,"Swath") if( ESMF_AlarmIsRinging ( Hsampler%alarm ) .and. .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then call MAPL_TimerOn(GENSTATE,"RegenGrid") key_grid_label = list(n)%output_grid_label @@ -3744,6 +3751,7 @@ subroutine Run ( gc, import, export, clock, rc ) if( MAPL_AM_I_ROOT() ) write(6,'(//)') call MAPL_TimerOff(GENSTATE,"RegenGrid") endif + call MAPL_TimerOff(GENSTATE,"Swath") end if call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_regen_grid @@ -3763,6 +3771,7 @@ subroutine Run ( gc, import, export, clock, rc ) call MAPL_TimerOn(GENSTATE,trim(list(n)%collection)) if (list(n)%timeseries_output) then + call MAPL_TimerOn(GENSTATE,"Trajectory") call MAPL_TimerOn(GENSTATE,"RegridAccum") call list(n)%trajectory%regrid_accumulate(_RC) call MAPL_TimerOff(GENSTATE,"RegridAccum") @@ -3777,6 +3786,7 @@ subroutine Run ( gc, import, export, clock, rc ) call MAPL_TimerOff(GENSTATE,"RegenLS") end if end if + call MAPL_TimerOff(GENSTATE,"Trajectory") end if if( Writing(n) .and. list(n)%unit < 0) then From 5b8a27ec16ce20cf794fa0e7249198560f5803f7 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 17 May 2024 11:15:54 -0600 Subject: [PATCH 18/61] . --- .../Sampler/MAPL_StationSamplerMod.F90 | 176 ++++++++---------- 1 file changed, 81 insertions(+), 95 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index bdcc72031f68..55ebe8935c88 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -489,7 +489,9 @@ subroutine append_file(this,current_time,rc) integer :: recvcount integer :: is, ie, ierr integer :: M, N, ip - + + type(GriddedIOitemVectorIterator) :: iter + type(GriddedIOitem), pointer :: item this%obs_written=this%obs_written+1 @@ -591,106 +593,90 @@ subroutine append_file(this,current_time,rc) end if else if (rank==3) then - ! -- regrid - ! -- LS ds->chunk - ! -- chunk->rt - ! - call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) - call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) - call ESMF_FieldGet(acc_field,farrayptr=p_acc_3d,_RC) - if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then - allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) - call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) - call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) - if (is > 0 .AND. is <= ie ) then - p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) - end if - else - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) - if (is > 0 .AND. is <= ie ) then - p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) - end if - end if - - - call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) - dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - - call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) - call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) - p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) - call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) - - if (this%level_by_level) then - ! p_dst (lm, nx) - allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) - do k = 1, lm - call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & - p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& - iroot, mpic, ierr ) - end do - deallocate (p_dst_t) - else - call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & - p_dst_rt, recvcount_v, displs_v, MPI_REAL,& - iroot, mpic, ierr ) - p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) - end if - - call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) - call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) - - - - call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - if (this%vdata%lm/=(ub(1)-lb(1)+1)) then - lb(1)=1 - ub(1)=this%vdata%lm - end if - dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& - typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) - - call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) - p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) - call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) - - if (mapl_am_i_root()) then - nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) - arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) - call this%formatter%put_var(xname,arr,& - start=[1,1,this%obs_written],count=[nz,nx,1],_RC) - !note: lev,station,time - deallocate(arr) - end if - call ESMF_FieldDestroy(dst_field,nogarbage=.true.) - +!! ! -- regrid +!! ! -- LS ds->chunk +!! ! -- chunk->rt +!! ! +!! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) +!! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) +!! call ESMF_FieldGet(acc_field,farrayptr=p_acc_3d,_RC) +!! if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then +!! allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) +!! call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) +!! call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) +!! if (is > 0 .AND. is <= ie ) then +!! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) +!! end if +!! else +!! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) +!! if (is > 0 .AND. is <= ie ) then +!! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) +!! end if +!! end if +!! +!! +!! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) +!! dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & +!! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) +!! src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & +!! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) +!! +!! call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) +!! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) +!! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) +!! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) +!! +!! if (this%level_by_level) then +!! ! p_dst (lm, nx) +!! allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) +!! do k = 1, lm +!! call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & +!! p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& +!! iroot, mpic, ierr ) +!! end do +!! deallocate (p_dst_t) +!! else +!! call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & +!! p_dst_rt, recvcount_v, displs_v, MPI_REAL,& +!! iroot, mpic, ierr ) +!! p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) +!! end if +!! +!! call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) +!! call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) +!! +!! +!! +!! call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) +!! if (this%vdata%lm/=(ub(1)-lb(1)+1)) then +!! lb(1)=1 +!! ub(1)=this%vdata%lm +!! end if +!! dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& +!! typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) +!! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) +!! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) +!! +!! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) +!! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) +!! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) +!! +!! if (mapl_am_i_root()) then +!! nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) +!! arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) +!! call this%formatter%put_var(xname,arr,& +!! start=[1,1,this%obs_written],count=[nz,nx,1],_RC) +!! !note: lev,station,time +!! deallocate(arr) +!! end if +!! call ESMF_FieldDestroy(dst_field,nogarbage=.true.) +!! else _FAIL('grid2LS regridder: rank > 3 not implemented') end if end do - - - call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) - call ESMF_FieldGet(src_field,rank=rank,_RC) - if (rank==1) then - call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_2d, _RC ) - call ESMF_FieldGet( acc_field_2d_chunk, localDE=0, farrayPtr=p_acc_chunk_2d, _RC ) - call ESMF_FieldRedist( acc_field, acc_field_2d_chunk, RH, _RC ) - call MPI_gatherv ( p_acc_chunk_2d, nsend, MPI_REAL, & - p_acc_rt_2d, recvcount, displs, MPI_REAL,& - iroot, mpic, ierr ) - - - - - call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) allocate (fieldNameList(fieldCount), _STAT) call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) From 871ded0ed90b4944a64421d6af356e1926434e3a Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Mon, 20 May 2024 14:27:54 -0600 Subject: [PATCH 19/61] verion for 2d regrid and gatherV --- .../Sampler/MAPL_StationSamplerMod.F90 | 278 +++++++++--------- 1 file changed, 147 insertions(+), 131 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index bdcc72031f68..a8ba53d720ee 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -4,6 +4,8 @@ module StationSamplerMod use MAPL_ErrorHandlingMod use LocStreamFactoryMod use pFIO + use MAPL_GriddedIOItemMod + use MAPL_GriddedIOItemVectorMod use MAPL_TimeDataMod use MAPL_VerticalDataMod use MAPL_BaseMod @@ -26,10 +28,14 @@ module StationSamplerMod type(ESMF_LocStream) :: LS_ds type(LocstreamRegridder) :: regridder type(ESMF_RouteHandle) :: RH + type(GriddedIOitemVector) :: items + logical :: do_vertical_regrid + integer :: nstation integer, allocatable :: station_id(:) character(len=ESMF_MAXSTR), allocatable :: station_name(:) character(len=ESMF_MAXSTR), allocatable :: station_fullname(:) + character(len=ESMF_MAXSTR) :: index_name_x real(kind=REAL64), allocatable :: lons(:) real(kind=REAL64), allocatable :: lats(:) real(kind=REAL64), allocatable :: elevs(:) @@ -40,6 +46,8 @@ module StationSamplerMod type(TimeData) :: time_info character(LEN=ESMF_MAXPATHLEN) :: ofile integer :: obs_written + + contains procedure :: add_metadata_route_handle procedure :: create_file_handle @@ -93,6 +101,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s ! ["name_short lat lon elev name_full"] ! + lgr => logging%get_logger('HISTORY.sampler') if ( MAPL_AM_I_ROOT() ) then open(newunit=unit, file=trim(filename), form='formatted', & access='sequential', status='old', _IOSTAT) @@ -213,16 +222,17 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s end if end do close(unit) - lgr => logging%get_logger('HISTORY.sampler') - call lgr%debug('%a %i8', 'nstation=', nstation) - call lgr%debug('%a %a %a', 'sampler%station_name(1:2) : ', & - trim(sampler%station_name(1)), trim(sampler%station_name(2))) - call lgr%debug('%a %f8.2 %f8.2', 'sampler%lons(1:2) : ',& - sampler%lons(1),sampler%lons(2)) - call lgr%debug('%a %f8.2 %f8.2', 'sampler%lats(1:2) : ',& - sampler%lats(1),sampler%lats(2)) + + write(6,*) 'nstation=', nstation + write(6,*) 'sampler%station_name(1:2) : ', & + trim(sampler%station_name(1)), trim(sampler%station_name(2)) + write(6,*) 'sampler%lons(1:2) : ',& + sampler%lons(1:2) + write(6,*) 'sampler%lats(1:2) : ',& + sampler%lats(1:2) else nstation=0 + sampler%nstation = 0 allocate(sampler%station_id(nstation), _STAT) allocate(sampler%station_name(nstation), _STAT) allocate(sampler%station_fullname(nstation), _STAT) @@ -230,8 +240,19 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s allocate(sampler%lats(nstation), _STAT) allocate(sampler%elevs(nstation), _STAT) end if + sampler%index_name_x = 'station_index' +! call lgr%debug('%a %i8', 'nstation=', nstation) +! call lgr%debug('%a %a %a', 'sampler%station_name(1:2) : ', & +! trim(sampler%station_name(1)), trim(sampler%station_name(2))) +! call lgr%debug('%a %f8.2 %f8.2', 'sampler%lons(1:2) : ',& +! sampler%lons(1),sampler%lons(2)) +! call lgr%debug('%a %f8.2 %f8.2', 'sampler%lats(1:2) : ',& +! sampler%lats(1),sampler%lats(2)) + + + !__ 2. create LocStreamFactory, then LS_rt including route_handle ! ! grid_A: LS_rt : on root @@ -307,6 +328,8 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) integer, optional, intent(out) :: rc type(variable) :: v + type(GriddedIOitemVectorIterator) :: iter + type(GriddedIOitem), pointer :: item type(ESMF_Grid) :: grid type(ESMF_Field) :: field integer :: fieldCount @@ -325,16 +348,21 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) type(ESMF_Field) :: src_field, chunk_field real(REAL32), pointer :: pt1(:), pt2(:) + !__ 1. metadata add_dimension, ! add_variable for time, latlon, station ! - this%bundle = bundle - nstation = this%nstation + if(present(bundle)) this%bundle=bundle + if(present(items)) this%items=items + if(present(timeInfo)) this%time_info=timeInfo if (present(vdata)) then this%vdata = vdata else this%vdata = VerticalData(_RC) end if + nstation = this%nstation + + call this%vdata%append_vertical_metadata(this%metadata,this%bundle,_RC) ! specify lev in fmd do_vertical_regrid = (this%vdata%regrid_type /= VERTICAL_METHOD_NONE) if (this%vdata%regrid_type == VERTICAL_METHOD_ETA2LEV) then @@ -369,7 +397,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() -!! print*, 'list item%xname', trim(item%xname) + print*, 'list item%xname', trim(item%xname) if (item%itemType == ItemTypeScalar) then call this%create_variable(item%xname,_RC) else if (item%itemType == ItemTypeVector) then @@ -402,7 +430,7 @@ end subroutine add_metadata_route_handle subroutine create_metadata_variable(this,vname,rc) - class(HistoryTrajectory), intent(inout) :: this + class(StationSampler), intent(inout) :: this character(len=*), intent(in) :: vname integer, optional, intent(out) :: rc @@ -411,8 +439,10 @@ subroutine create_metadata_variable(this,vname,rc) logical :: is_present integer :: field_rank, status character(len=ESMF_MAXSTR) :: var_name,long_name,units,vdims + integer :: rank,lb(1),ub(1) integer :: k, ig + call ESMF_FieldBundleGet(this%bundle,vname,field=field,_RC) call ESMF_FieldGet(field,name=var_name,rank=field_rank,_RC) call ESMF_AttributeGet(field,name="LONG_NAME",isPresent=is_present,_RC) @@ -435,7 +465,7 @@ subroutine create_metadata_variable(this,vname,rc) if (field_rank==2) then vdims = "station_index,time" - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[nstation,1]) + v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[this%nstation,1]) else if (field_rank==3) then vdims = "lev,station_index,time" call ESMF_FieldGet(field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) @@ -462,37 +492,42 @@ subroutine append_file(this,current_time,rc) integer :: status integer :: fieldCount integer :: ub(1), lb(1) + type(GriddedIOitemVectorIterator) :: iter + type(GriddedIOitem), pointer :: item type(ESMF_Field) :: src_field,dst_field real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:) real(kind=REAL32), pointer :: p_ds_3d(:,:),p_ds_2d(:) real(kind=REAL32), pointer :: p_chunk_3d(:,:),p_chunk_2d(:) real(kind=REAL32), pointer :: p_rt_3d(:,:),p_rt_2d(:) - + real(kind=REAL32), allocatable :: p_new_lev(:,:,:) + real(kind=REAL32), allocatable :: arr(:,:) character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: xname real(kind=ESMF_KIND_R8), allocatable :: rtimes(:) - integer :: i, rank - integer :: nx, nz + + integer :: rank + integer :: i, nz, lm type(ESMF_VM) :: vm - integer :: mypet, petcount, mpic - integer :: nx, nx_sum - integer :: n0 - integer :: arr(1) + integer :: mypet, petcount, mpic, iroot + integer :: n0, nx, nx2 + integer :: na, nb, nx_sum, nsend, nsend_v + + type(ESMF_Field) :: field_ds_2d, field_ds_3d + type(ESMF_Field) :: field_chunk_2d, field_chunk_3d + type(ESMF_Field) :: field_rt_2d, field_rt_3d + integer :: sec integer, allocatable :: ix(:) ! counter for each obs(k)%nobs_epoch - integer :: nx2 logical :: EX ! file logical :: zero_obs - integer, allocatable :: sendcount(:), displs(:) - integer :: recvcount + integer, allocatable :: recvcount(:), sendcount(:), displs(:) + integer, allocatable :: recvcount_v(:), displs_v(:) integer :: is, ie, ierr integer :: M, N, ip - this%obs_written=this%obs_written+1 - !__ 1. put_var: time variable ! @@ -507,15 +542,17 @@ subroutine append_file(this,current_time,rc) ! lm = this%vdata%lm - field_ds_2d = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) - field_ds_3d = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) + field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - + field_rt_2d = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) + field_rt_3d = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) ! caution about zero-sized array for MPI ! redist @@ -549,16 +586,6 @@ subroutine append_file(this,current_time,rc) else allocate ( p_rt_2d(1) ) end if -! ! -! ! p_dst (lm, nx) -! if (mapl_am_i_root()) then -! allocate ( p_acc_rt_3d(nx_sum,lm) ) -! allocate ( p_dst_rt(lm, nx_sum) ) -! else -! allocate ( p_acc_rt_3d(1,lm) ) -! allocate ( p_dst_rt(lm, 1) ) -! end if - ! ! reuse @@ -596,109 +623,98 @@ subroutine append_file(this,current_time,rc) ! -- chunk->rt ! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) - call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) - call ESMF_FieldGet(acc_field,farrayptr=p_acc_3d,_RC) - if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then - allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) - call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) - call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) - if (is > 0 .AND. is <= ie ) then - p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) - end if - else - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) - if (is > 0 .AND. is <= ie ) then - p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) - end if - end if - - - call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) - dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - - call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) - call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) - p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) - call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) - - if (this%level_by_level) then - ! p_dst (lm, nx) - allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) - do k = 1, lm - call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & - p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& - iroot, mpic, ierr ) - end do - deallocate (p_dst_t) - else - call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & - p_dst_rt, recvcount_v, displs_v, MPI_REAL,& - iroot, mpic, ierr ) - p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) - end if - - call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) - call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) - - call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - if (this%vdata%lm/=(ub(1)-lb(1)+1)) then - lb(1)=1 - ub(1)=this%vdata%lm - end if - dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& - typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) - - call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) - p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) - call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) - - if (mapl_am_i_root()) then - nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) - arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) - call this%formatter%put_var(xname,arr,& - start=[1,1,this%obs_written],count=[nz,nx,1],_RC) - !note: lev,station,time - deallocate(arr) - end if - call ESMF_FieldDestroy(dst_field,nogarbage=.true.) +! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) +! if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then +! allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) +! call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) +! call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) +! if (is > 0 .AND. is <= ie ) then +! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) +! end if +! else +! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) +! if (is > 0 .AND. is <= ie ) then +! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) +! end if +! end if +! +! +! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) +! dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & +! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) +! src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & +! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) +! +! call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) +! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) +! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) +! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) +! +! if (this%level_by_level) then +! ! p_dst (lm, nx) +! allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) +! do k = 1, lm +! call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & +! p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& +! iroot, mpic, ierr ) +! end do +! deallocate (p_dst_t) +! else +! call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & +! p_dst_rt, recvcount_v, displs_v, MPI_REAL,& +! iroot, mpic, ierr ) +! p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) +! end if +! +! call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) +! call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) +! +! +! +! call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) +! if (this%vdata%lm/=(ub(1)-lb(1)+1)) then +! lb(1)=1 +! ub(1)=this%vdata%lm +! end if +! dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& +! typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) +! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) +! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) +! +! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) +! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) +! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) +! +! if (mapl_am_i_root()) then +! nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) +! arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) +! call this%formatter%put_var(xname,arr,& +! start=[1,1,this%obs_written],count=[nz,nx,1],_RC) +! !note: lev,station,time +! deallocate(arr) +! end if +! call ESMF_FieldDestroy(dst_field,nogarbage=.true.) else _FAIL('grid2LS regridder: rank > 3 not implemented') end if - end do - - - - call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) - call ESMF_FieldGet(src_field,rank=rank,_RC) - if (rank==1) then - call ESMF_FieldGet( acc_field, localDE=0, farrayPtr=p_acc_2d, _RC ) - call ESMF_FieldGet( acc_field_2d_chunk, localDE=0, farrayPtr=p_acc_chunk_2d, _RC ) - call ESMF_FieldRedist( acc_field, acc_field_2d_chunk, RH, _RC ) - call MPI_gatherv ( p_acc_chunk_2d, nsend, MPI_REAL, & - p_acc_rt_2d, recvcount, displs, MPI_REAL,& - iroot, mpic, ierr ) - - - - + endif + end do - call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) - allocate (fieldNameList(fieldCount), _STAT) - call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) - do i=1, fieldCount - xname=trim(fieldNameList(i)) +!!! call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) +! call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) +! allocate (fieldNameList(fieldCount), _STAT) +! call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) +! do i=1, fieldCount +! xname=trim(fieldNameList(i)) +! deallocate (fieldNameList) +! end do +! - deallocate (fieldNameList) _RETURN(_SUCCESS) end subroutine append_file From a69347f5f6d317240bda6962014903aaeb0ceafd Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Mon, 20 May 2024 18:06:36 -0600 Subject: [PATCH 20/61] . --- gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index a8ba53d720ee..c7171b07f252 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -507,7 +507,7 @@ subroutine append_file(this,current_time,rc) real(kind=ESMF_KIND_R8), allocatable :: rtimes(:) integer :: rank - integer :: i, nz, lm + integer :: i, j, nz, lm type(ESMF_VM) :: vm integer :: mypet, petcount, mpic, iroot @@ -613,8 +613,14 @@ subroutine append_file(this,current_time,rc) iroot, mpic, ierr ) if (mapl_am_i_root()) then - call this%formatter%put_var(xname,p_rt_2d,& - start=[1,this%obs_written],count=[this%nstation,1],_RC) + do j=1, nx_sum, 500000 + write(6,*) 'p_rt_2d', p_rt_2d(j) + end do + end if + + if (mapl_am_i_root()) then +! call this%formatter%put_var(xname,p_rt_2d,& +! start=[1,this%obs_written],count=[this%nstation,1],_RC) end if else if (rank==3) then From fe6679da3130fae4a101e2534e59f7a35a6ec900 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 10:49:37 -0600 Subject: [PATCH 21/61] A version using mpi gatherv --- .../Sampler/MAPL_StationSamplerMod.F90 | 287 +++++++----------- 1 file changed, 118 insertions(+), 169 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index c0417cab225c..cfbb6e11931c 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -30,7 +30,8 @@ module StationSamplerMod type(ESMF_RouteHandle) :: RH type(GriddedIOitemVector) :: items logical :: do_vertical_regrid - + logical :: level_by_level + integer :: nstation integer, allocatable :: station_id(:) character(len=ESMF_MAXSTR), allocatable :: station_name(:) @@ -46,7 +47,6 @@ module StationSamplerMod type(TimeData) :: time_info character(LEN=ESMF_MAXPATHLEN) :: ofile integer :: obs_written - contains procedure :: add_metadata_route_handle @@ -241,16 +241,6 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s allocate(sampler%elevs(nstation), _STAT) end if sampler%index_name_x = 'station_index' - - -! call lgr%debug('%a %i8', 'nstation=', nstation) -! call lgr%debug('%a %a %a', 'sampler%station_name(1:2) : ', & -! trim(sampler%station_name(1)), trim(sampler%station_name(2))) -! call lgr%debug('%a %f8.2 %f8.2', 'sampler%lons(1:2) : ',& -! sampler%lons(1),sampler%lons(2)) -! call lgr%debug('%a %f8.2 %f8.2', 'sampler%lats(1:2) : ',& -! sampler%lats(1),sampler%lats(2)) - !__ 2. create LocStreamFactory, then LS_rt including route_handle @@ -314,7 +304,8 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s ! init ofile sampler%ofile='' sampler%obs_written=0 - + sampler%level_by_level = .true. + _RETURN(_SUCCESS) end function new_StationSampler_readfile @@ -349,8 +340,8 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) real(REAL32), pointer :: pt1(:), pt2(:) - !__ 1. metadata add_dimension, - ! add_variable for time, latlon, station + !__ 1. filemetadata: + ! add_dimension, add_variable for latlon, station ! if(present(bundle)) this%bundle=bundle if(present(items)) this%items=items @@ -362,7 +353,6 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) end if nstation = this%nstation - call this%vdata%append_vertical_metadata(this%metadata,this%bundle,_RC) ! specify lev in fmd do_vertical_regrid = (this%vdata%regrid_type /= VERTICAL_METHOD_NONE) if (this%vdata%regrid_type == VERTICAL_METHOD_ETA2LEV) then @@ -392,12 +382,12 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) !__ 2. filemetadata: - ! create varible with names in metadata; see create_metadata_variable + ! create varible with names in item%xname; see create_metadata_variable ! iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - print*, 'list item%xname', trim(item%xname) + print*, 'list item%xname', trim(item%xname) if (item%itemType == ItemTypeScalar) then call this%create_variable(item%xname,_RC) else if (item%itemType == ItemTypeVector) then @@ -431,8 +421,8 @@ end subroutine add_metadata_route_handle subroutine create_metadata_variable(this,vname,rc) class(StationSampler), intent(inout) :: this - character(len=*), intent(in) :: vname - integer, optional, intent(out) :: rc + character(len=*), intent(in) :: vname + integer, optional, intent(out) :: rc type(ESMF_Field) :: field type(variable) :: v @@ -457,11 +447,13 @@ subroutine create_metadata_variable(this,vname,rc) else units = 'unknown' endif - if (field_rank==2) then - vdims = this%index_name_x - else if (field_rank==3) then - vdims = trim(this%index_name_x)//",lev" - end if + +! -- in future, replace keyword station by index_name_x as in trajectory sampler +! if (field_rank==2) then +! vdims = this%index_name_x +! else if (field_rank==3) then +! vdims = trim(this%index_name_x)//",lev" +! end if if (field_rank==2) then vdims = "station_index,time" @@ -495,11 +487,14 @@ subroutine append_file(this,current_time,rc) type(GriddedIOitemVectorIterator) :: iter type(GriddedIOitem), pointer :: item type(ESMF_Field) :: src_field,dst_field - real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:) - real(kind=REAL32), pointer :: p_ds_3d(:,:),p_ds_2d(:) - real(kind=REAL32), pointer :: p_chunk_3d(:,:),p_chunk_2d(:) - real(kind=REAL32), pointer :: p_rt_3d(:,:),p_rt_2d(:) + real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:) ! source + real(kind=REAL32), pointer :: p_dst_3d(:,:) ! destination + real(kind=REAL32), pointer :: p_ds_3d(:,:),p_ds_2d(:) ! distributed LS + real(kind=REAL32), pointer :: p_chunk_3d(:,:),p_chunk_2d(:) ! chunk LS + real(kind=REAL32), pointer :: p_rt_3d(:,:),p_rt_2d(:) ! root LS + real(kind=REAL32), pointer :: p_rt_3d_aux(:,:) real(kind=REAL32), allocatable :: p_new_lev(:,:,:) + real(kind=REAL32), allocatable :: p_dst_t(:,:) real(kind=REAL32), allocatable :: arr(:,:) character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) @@ -507,7 +502,7 @@ subroutine append_file(this,current_time,rc) real(kind=ESMF_KIND_R8), allocatable :: rtimes(:) integer :: rank - integer :: i, j, nz, lm + integer :: i, j, k, nz, lm type(ESMF_VM) :: vm integer :: mypet, petcount, mpic, iroot @@ -527,13 +522,12 @@ subroutine append_file(this,current_time,rc) integer :: is, ie, ierr integer :: M, N, ip - type(GriddedIOitemVectorIterator) :: iter - type(GriddedIOitem), pointer :: item this%obs_written=this%obs_written+1 !__ 1. put_var: time variable ! + ! rtimes = this%compute_time_for_current(current_time,_RC) ! rtimes: seconds since opening file if (mapl_am_i_root()) then call this%formatter%put_var('time',rtimes(1:1),& @@ -541,22 +535,16 @@ subroutine append_file(this,current_time,rc) end if - !__ 2. regrid + put_var: ungridded_dim from src to dst [regrid] + !__ 2. regrid + put_var: + ! ungridded_dim from src to dst [regrid] ! - lm = this%vdata%lm - field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) - field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) - field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - - field_rt_2d = ESMF_FieldCreate (this%LS_rt, name='field_2d_rt', typekind=ESMF_TYPEKIND_R4, _RC) - field_rt_3d = ESMF_FieldCreate (this%LS_rt, name='field_3d_rt', typekind=ESMF_TYPEKIND_R4, & + dst_field = ESMF_FieldCreate (this%LS_ds, name='dst_field', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + ! caution about zero-sized array for MPI ! redist nx_sum = this%nstation @@ -579,7 +567,7 @@ subroutine append_file(this,current_time,rc) do i = 2, petCount displs(i) = displs(i-1) + recvcount(i-1) end do - + nsend_v = nsend * lm ! vertical allocate (recvcount_v, source = recvcount * lm ) allocate (displs_v, source = displs * lm ) @@ -589,140 +577,101 @@ subroutine append_file(this,current_time,rc) else allocate ( p_rt_2d(1) ) end if - - ! - ! reuse - ! the pointers p_ds_2d, p_ds_3d, in field_ds_2d, field_ds_3d - ! the pointers p_chunk_2d, p_chunk_3d in field_chunk_2d, field_chunk_3d - ! gather to p_rt_2d, p_rt_3d - ! + + ! p_rt_3d (lm, nx) + if (mapl_am_i_root()) then + allocate ( p_rt_3d(lm, nx_sum) ) + allocate ( p_rt_3d_aux(nx_sum, lm) ) + else + allocate ( p_rt_3d(lm, 1) ) + allocate ( p_rt_3d_aux(1,lm) ) + end if + + iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() 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) - if (rank==2) then - call ESMF_FieldGet(src_field,farrayptr=p_src_2d,_RC) - call ESMF_FieldGet(field_ds_2d,farrayptr=p_ds_2d,_RC) - call ESMF_FieldGet(field_chunk_2d,farrayPtr=p_chunk_2d,_RC) - call ESMF_FieldGet(field_rt_2d,farrayPtr=p_rt_2d,_RC) - - call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) - call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) - call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & - p_rt_2d, recvcount, displs, MPI_REAL,& - iroot, mpic, ierr ) - - if (mapl_am_i_root()) then - do j=1, nx_sum, 500000 - write(6,*) 'p_rt_2d', p_rt_2d(j) - end do - end if - - if (mapl_am_i_root()) then -! call this%formatter%put_var(xname,p_rt_2d,& -! start=[1,this%obs_written],count=[this%nstation,1],_RC) - end if - - else if (rank==3) then - ! -- regrid - ! -- LS ds->chunk - ! -- chunk->rt - ! - call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) - - -! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) -! if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then -! allocate(p_new_lev(size(p_src_3d,1),size(p_src_3d,2),this%vdata%lm),_STAT) -! call this%vdata%regrid_eta_to_pressure(p_src_3d,p_new_lev,_RC) -! call this%regridder%regrid(p_new_lev,p_dst_3d,_RC) -! if (is > 0 .AND. is <= ie ) then -! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) -! end if -! else -! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) -! if (is > 0 .AND. is <= ie ) then -! p_acc_3d(is:ie,:) = p_dst_3d(is:ie,:) + call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) + call ESMF_FieldGet(src_field,rank=rank,_RC) + if (rank==2) then + call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_2d,_RC) + call ESMF_FieldGet(field_ds_2d,localDE=0,farrayptr=p_ds_2d,_RC) + call ESMF_FieldGet(field_chunk_2d,localDE=0,farrayPtr=p_chunk_2d,_RC) + + call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) + call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) + call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & + p_rt_2d, recvcount, displs, MPI_REAL,& + iroot, mpic, ierr ) + +! if (mapl_am_i_root()) then +! do j=1, nx_sum, 500000 +! write(6,*) 'p_rt_2d', p_rt_2d(j) +! end do ! end if -! end if -! -! -! call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) -! dst_field=ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4, & -! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) -! src_field=ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4, & -! gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) -! -! call ESMF_FieldGet(src_field,localDE=0,farrayPtr=p_src,_RC) -! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) -! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) -! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) -! -! if (this%level_by_level) then -! ! p_dst (lm, nx) -! allocate ( p_dst_t, source = reshape ( p_dst, [size(p_dst,2),size(p_dst,1)], order=[2,1] ) ) -! do k = 1, lm -! call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & -! p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& -! iroot, mpic, ierr ) -! end do -! deallocate (p_dst_t) -! else -! call MPI_gatherv ( p_dst, nsend_v, MPI_REAL, & -! p_dst_rt, recvcount_v, displs_v, MPI_REAL,& -! iroot, mpic, ierr ) -! p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) -! end if -! -! call ESMF_FieldDestroy(dst_field,noGarbage=.true.,_RC) -! call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) -! -! -! -! call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) -! if (this%vdata%lm/=(ub(1)-lb(1)+1)) then -! lb(1)=1 -! ub(1)=this%vdata%lm -! end if -! dst_field = ESMF_FieldCreate(this%LS_ds,name=xname,& -! typekind=ESMF_TYPEKIND_R4,ungriddedLBound=lb,ungriddedUBound=ub,_RC) -! call ESMF_FieldGet(dst_field,farrayptr=p_dst_3d,_RC) -! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) -! -! call ESMF_FieldGet(dst_field,localDE=0,farrayPtr=p_dst,_RC) -! p_src= reshape(p_acc_3d,shape(p_src), order=[2,1]) -! call ESMF_FieldRegrid(src_field,dst_field,RH,_RC) -! -! if (mapl_am_i_root()) then -! nx=size(p_dst_3d,1); nz=size(p_dst_3d,2); allocate(arr(nz, nx), _STAT) -! arr=reshape(p_dst_3d,[nz,nx],order=[2,1]) -! call this%formatter%put_var(xname,arr,& -! start=[1,1,this%obs_written],count=[nz,nx,1],_RC) -! !note: lev,station,time -! deallocate(arr) -! end if -! call ESMF_FieldDestroy(dst_field,nogarbage=.true.) + if (mapl_am_i_root()) then + call this%formatter%put_var(trim(item%xname),p_rt_2d,& + start=[1,this%obs_written],count=[this%nstation,1],_RC) + end if - else - _FAIL('grid2LS regridder: rank > 3 not implemented') - end if - endif - end do - + else if (rank==3) then + ! -- CS-> LS_ds; ds->chunk; gather + ! + call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) + call ESMF_FieldGet(dst_field,localDE=0,farrayptr=p_dst_3d,_RC) + call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + + field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) + call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) + + ! p_ds_3d(lm, nx) + p_ds_3d = reshape(p_dst_3d, shape(p_ds_3d), order=[2,1]) + call ESMF_FieldRedist(field_ds_3d, field_chunk_3d, this%RH, _RC) + + if (this%level_by_level) then + ! p_chunk_3d (lm, nx) + allocate (p_dst_t, source = reshape(p_chunk_3d, [size(p_chunk_3d,2),size(p_chunk_3d,1)], order=[2,1])) + do k = 1, lm + call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & + p_rt_3d_aux(1,k), recvcount, displs, MPI_REAL,& + iroot, mpic, ierr ) + end do + p_rt_3d = reshape(p_rt_3d_aux, shape(p_rt_3d), order=[2,1]) + else + call MPI_gatherv ( p_chunk_3d, nsend_v, MPI_REAL, & + p_rt_3d, recvcount_v, displs_v, MPI_REAL,& + iroot, mpic, ierr ) + end if + call ESMF_FieldDestroy(field_ds_3d,noGarbage=.true.,_RC) + call ESMF_FieldDestroy(field_chunk_3d,noGarbage=.true.,_RC) -!!! call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) -! call ESMF_FieldBundleGet(this%bundle, fieldCount=fieldCount, _RC) -! allocate (fieldNameList(fieldCount), _STAT) -! call ESMF_FieldBundleGet(this%bundle, fieldNameList=fieldNameList, _RC) -! do i=1, fieldCount -! xname=trim(fieldNameList(i)) -! deallocate (fieldNameList) -! end do -! +! if (mapl_am_i_root()) then +! do j=1, nx_sum, 500 +! write(6,*) 'p_rt_3d', p_rt_3d(:,j) +! end do +! end if +! if (mapl_am_i_root()) write(6,*) 'regrid + gatherV in 3D' + + if (mapl_am_i_root()) then + nz=size(p_rt_3d,1); nx=size(p_rt_3d,2) + call this%formatter%put_var(trim(item%xname),p_rt_3d,& + start=[1,1,this%obs_written],count=[nz,nx,1],_RC) + !note: lev,station,time + end if + else + _FAIL('grid2LS regridder: rank > 3 not implemented') + end if + endif + + call iter%next() + end do _RETURN(_SUCCESS) end subroutine append_file From 8f86b1e0652b49f19efdd97caf118f6712ac7bb5 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 10:52:16 -0600 Subject: [PATCH 22/61] clean --- .../Sampler/MAPL_StationSamplerMod.F90 | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index cfbb6e11931c..4d5c08b78b6b 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -25,13 +25,13 @@ module StationSamplerMod type(LocStreamFactory) :: LSF type(ESMF_LocStream) :: LS_rt type(ESMF_LocStream) :: LS_chunk - type(ESMF_LocStream) :: LS_ds + type(ESMF_LocStream) :: LS_ds type(LocstreamRegridder) :: regridder type(ESMF_RouteHandle) :: RH type(GriddedIOitemVector) :: items logical :: do_vertical_regrid logical :: level_by_level - + integer :: nstation integer, allocatable :: station_id(:) character(len=ESMF_MAXSTR), allocatable :: station_name(:) @@ -47,7 +47,7 @@ module StationSamplerMod type(TimeData) :: time_info character(LEN=ESMF_MAXPATHLEN) :: ofile integer :: obs_written - + contains procedure :: add_metadata_route_handle procedure :: create_file_handle @@ -82,10 +82,10 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s integer :: M, N, ip integer :: arr(1) integer :: nx, nx2, nx_sum - + real(REAL64), allocatable :: lons_chunk(:) real(REAL64), allocatable :: lats_chunk(:) - + integer :: unit, ios, nstation, status integer :: i, j, k, ncount logical :: con1, con2 @@ -102,7 +102,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s ! lgr => logging%get_logger('HISTORY.sampler') - if ( MAPL_AM_I_ROOT() ) then + if ( MAPL_AM_I_ROOT() ) then open(newunit=unit, file=trim(filename), form='formatted', & access='sequential', status='old', _IOSTAT) ios=0 @@ -222,7 +222,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s end if end do close(unit) - + write(6,*) 'nstation=', nstation write(6,*) 'sampler%station_name(1:2) : ', & trim(sampler%station_name(1)), trim(sampler%station_name(2)) @@ -232,7 +232,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s sampler%lats(1:2) else nstation=0 - sampler%nstation = 0 + sampler%nstation = 0 allocate(sampler%station_id(nstation), _STAT) allocate(sampler%station_name(nstation), _STAT) allocate(sampler%station_fullname(nstation), _STAT) @@ -241,7 +241,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s allocate(sampler%elevs(nstation), _STAT) end if sampler%index_name_x = 'station_index' - + !__ 2. create LocStreamFactory, then LS_rt including route_handle ! @@ -252,7 +252,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, petCount=petCount, localPet=mypet, _RC) call MAPL_CommsBcast(vm, DATA=sampler%nstation, N=1, ROOT=MAPL_Root, _RC) - + nx_sum = sampler%nstation ip = mypet ! 0 to M-1 N = nx_sum @@ -299,13 +299,13 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s ! -- distributed call ESMF_FieldBundleGet(bundle,grid=grid,_RC) sampler%LS_ds = sampler%LSF%create_locstream_on_proc(grid=grid,_RC) - + ! ! init ofile sampler%ofile='' sampler%obs_written=0 sampler%level_by_level = .true. - + _RETURN(_SUCCESS) end function new_StationSampler_readfile @@ -339,7 +339,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) type(ESMF_Field) :: src_field, chunk_field real(REAL32), pointer :: pt1(:), pt2(:) - + !__ 1. filemetadata: ! add_dimension, add_variable for latlon, station ! @@ -404,7 +404,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) this%regridder = LocStreamRegridder(grid,this%LS_ds,_RC) !__ 4. route handle LS_ds --> LS_chunk - ! + ! src_field = ESMF_FieldCreate(this%LS_ds,typekind=ESMF_TYPEKIND_R4,gridToFieldMap=[1],_RC) chunk_field = ESMF_FieldCreate(this%LS_chunk,typekind=ESMF_TYPEKIND_R4,gridToFieldMap=[1],_RC) call ESMF_FieldGet( src_field, localDE=0, farrayPtr=pt1, _RC ) @@ -414,7 +414,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) call ESMF_FieldRedistStore(src_field,chunk_field,this%RH,_RC) call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) call ESMF_FieldDestroy(chunk_field,noGarbage=.true.,_RC) - + _RETURN(_SUCCESS) end subroutine add_metadata_route_handle @@ -423,7 +423,7 @@ subroutine create_metadata_variable(this,vname,rc) class(StationSampler), intent(inout) :: this character(len=*), intent(in) :: vname integer, optional, intent(out) :: rc - + type(ESMF_Field) :: field type(variable) :: v logical :: is_present @@ -432,7 +432,7 @@ subroutine create_metadata_variable(this,vname,rc) integer :: rank,lb(1),ub(1) integer :: k, ig - + call ESMF_FieldBundleGet(this%bundle,vname,field=field,_RC) call ESMF_FieldGet(field,name=var_name,rank=field_rank,_RC) call ESMF_AttributeGet(field,name="LONG_NAME",isPresent=is_present,_RC) @@ -448,7 +448,7 @@ subroutine create_metadata_variable(this,vname,rc) units = 'unknown' endif -! -- in future, replace keyword station by index_name_x as in trajectory sampler +! -- in future, replace keyword station by index_name_x as in trajectory sampler ! if (field_rank==2) then ! vdims = this%index_name_x ! else if (field_rank==3) then @@ -494,8 +494,8 @@ subroutine append_file(this,current_time,rc) real(kind=REAL32), pointer :: p_rt_3d(:,:),p_rt_2d(:) ! root LS real(kind=REAL32), pointer :: p_rt_3d_aux(:,:) real(kind=REAL32), allocatable :: p_new_lev(:,:,:) - real(kind=REAL32), allocatable :: p_dst_t(:,:) - + real(kind=REAL32), allocatable :: p_dst_t(:,:) + real(kind=REAL32), allocatable :: arr(:,:) character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: xname @@ -511,8 +511,8 @@ subroutine append_file(this,current_time,rc) type(ESMF_Field) :: field_ds_2d, field_ds_3d type(ESMF_Field) :: field_chunk_2d, field_chunk_3d - type(ESMF_Field) :: field_rt_2d, field_rt_3d - + type(ESMF_Field) :: field_rt_2d, field_rt_3d + integer :: sec integer, allocatable :: ix(:) ! counter for each obs(k)%nobs_epoch logical :: EX ! file @@ -522,9 +522,9 @@ subroutine append_file(this,current_time,rc) integer :: is, ie, ierr integer :: M, N, ip - + this%obs_written=this%obs_written+1 - + !__ 1. put_var: time variable ! ! @@ -539,14 +539,14 @@ subroutine append_file(this,current_time,rc) ! ungridded_dim from src to dst [regrid] ! lm = this%vdata%lm - field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) dst_field = ESMF_FieldCreate (this%LS_ds, name='dst_field', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - - + + ! caution about zero-sized array for MPI - ! redist + ! redist nx_sum = this%nstation call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, petCount=petCount, localPet=mypet, _RC) @@ -584,7 +584,7 @@ subroutine append_file(this,current_time,rc) allocate ( p_rt_3d_aux(nx_sum, lm) ) else allocate ( p_rt_3d(lm, 1) ) - allocate ( p_rt_3d_aux(1,lm) ) + allocate ( p_rt_3d_aux(1,lm) ) end if @@ -619,7 +619,7 @@ subroutine append_file(this,current_time,rc) else if (rank==3) then ! -- CS-> LS_ds; ds->chunk; gather - ! + ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) call ESMF_FieldGet(dst_field,localDE=0,farrayptr=p_dst_3d,_RC) call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) @@ -628,7 +628,7 @@ subroutine append_file(this,current_time,rc) gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) + call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) ! p_ds_3d(lm, nx) @@ -843,7 +843,7 @@ subroutine get_file_start_time(this,start_time,time_units,rc) _RETURN(_SUCCESS) end subroutine get_file_start_time - + ! TODO: delete and use system utilities when available Subroutine count_substring (str, t, ncount, rc) character (len=*), intent(in) :: str From 72218e6e8b38ec9d3f1643cf1bde0565306be5a8 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 13:31:31 -0600 Subject: [PATCH 23/61] add deallocate(p_dst_t) --- gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 4d5c08b78b6b..70520a46e4a6 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -387,7 +387,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - print*, 'list item%xname', trim(item%xname) + !!print*, 'list item%xname', trim(item%xname) if (item%itemType == ItemTypeScalar) then call this%create_variable(item%xname,_RC) else if (item%itemType == ItemTypeVector) then @@ -643,6 +643,7 @@ subroutine append_file(this,current_time,rc) p_rt_3d_aux(1,k), recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) end do + deallocate(p_dst_t) p_rt_3d = reshape(p_rt_3d_aux, shape(p_rt_3d), order=[2,1]) else call MPI_gatherv ( p_chunk_3d, nsend_v, MPI_REAL, & From e85a6448eba72e474b8844f1709710064585f5b7 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 21:00:32 -0600 Subject: [PATCH 24/61] update --- .../Sampler/MAPL_StationSamplerMod.F90 | 44 +++++++++---------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 70520a46e4a6..096d39d0cf9f 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -431,38 +431,33 @@ subroutine create_metadata_variable(this,vname,rc) character(len=ESMF_MAXSTR) :: var_name,long_name,units,vdims integer :: rank,lb(1),ub(1) integer :: k, ig - + integer, allocatable :: chunksizes(:) call ESMF_FieldBundleGet(this%bundle,vname,field=field,_RC) call ESMF_FieldGet(field,name=var_name,rank=field_rank,_RC) call ESMF_AttributeGet(field,name="LONG_NAME",isPresent=is_present,_RC) + long_name = var_name if ( is_present ) then call ESMF_AttributeGet (FIELD, NAME="LONG_NAME",VALUE=long_name, _RC) - else - long_name = var_name endif call ESMF_AttributeGet(field,name="UNITS",isPresent=is_present,_RC) + units = 'unknown' if ( is_present ) then call ESMF_AttributeGet (FIELD, NAME="UNITS",VALUE=units, _RC) - else - units = 'unknown' endif -! -- in future, replace keyword station by index_name_x as in trajectory sampler -! if (field_rank==2) then -! vdims = this%index_name_x -! else if (field_rank==3) then -! vdims = trim(this%index_name_x)//",lev" -! end if - - if (field_rank==2) then - vdims = "station_index,time" - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[this%nstation,1]) - else if (field_rank==3) then - vdims = "lev,station_index,time" + vdims = "station_index,time" + select case (field_rank) + case(2) + chunksizes = [this%nstation,1] + case(3) + vdims = "lev,"//trim(vdims) call ESMF_FieldGet(field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[ub(1)-lb(1)+1,1,1]) - end if + chunksizes = [ub(1)-lb(1)+1,1,1] + case default + _FAIL('unsupported rank') + end select + v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=chunksizes) call v%add_attribute('units',trim(units)) call v%add_attribute('long_name',trim(long_name)) @@ -595,7 +590,8 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) call ESMF_FieldGet(src_field,rank=rank,_RC) - if (rank==2) then + select case (rank) + case(2) call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_2d,_RC) call ESMF_FieldGet(field_ds_2d,localDE=0,farrayptr=p_ds_2d,_RC) call ESMF_FieldGet(field_chunk_2d,localDE=0,farrayPtr=p_chunk_2d,_RC) @@ -617,7 +613,7 @@ subroutine append_file(this,current_time,rc) start=[1,this%obs_written],count=[this%nstation,1],_RC) end if - else if (rank==3) then + case(3) ! -- CS-> LS_ds; ds->chunk; gather ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) @@ -666,9 +662,11 @@ subroutine append_file(this,current_time,rc) start=[1,1,this%obs_written],count=[nz,nx,1],_RC) !note: lev,station,time end if - else + case default _FAIL('grid2LS regridder: rank > 3 not implemented') - end if + end select + else + _FAIL ('ItemType vector not supported') endif call iter%next() From d546b93280d9523c1eead069cf8bfefca6e3754b Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 22:01:25 -0600 Subject: [PATCH 25/61] debug Nx Ny decomp --- base/MAPL_SwathGridFactory.F90 | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index 93bf1b563c41..e89c6b0fd8d4 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -482,6 +482,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _ASSERT (this%lm /= MAPL_UNDEFINED_INTEGER, 'LM: is undefined in swath grid') call lgr%debug(' %a %a', 'CurrTime =', trim(tmp)) + call lgr%debug(' %a %i5 %i5', 'nx,ny =', this%nx, this%ny) if ( index(tmp, 'T') /= 0 .OR. index(tmp, '-') /= 0 ) then call ESMF_TimeSet(currTime, timeString=tmp, _RC) @@ -716,6 +717,13 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc else call get_multi_integer(this%jms, 'JMS:', _RC) endif + + if (mapl_am_i_root()) then +! write(6,*) 'ims ', this%ims +! write(6,*) 'jms ', this%jms + end if + + ! ims is set at here call this%check_and_fill_consistency(_RC) @@ -858,13 +866,33 @@ subroutine check_and_fill_consistency(this, unusable, rc) call verify(this%nx, this%im_world, this%ims, rc=status) call verify(this%ny, this%jm_world, this%jms, rc=status) + + if (mapl_am_i_root()) then + write(6,*) 'bf check fill consistency' + write(6,*) 'ims ', this%ims + write(6,*) 'jms ', this%jms + write(6,*) 'im_world ', this%im_world + write(6,*) 'jm_world ', this%jm_world + end if + if (.not.this%force_decomposition) then verify_decomp = this%check_decomposition(_RC) if ( (.not.verify_decomp) ) then call this%generate_newnxy(_RC) + write(6,*) 'af this%generate_newnxy' end if end if + + if (mapl_am_i_root()) then + write(6,*) 'af check fill consistency' + write(6,*) 'ims ', this%ims + write(6,*) 'jms ', this%jms + write(6,*) 'im_world ', this%im_world + write(6,*) 'jm_world ', this%jm_world + end if + + _RETURN(_SUCCESS) contains From 68998b8eb587774b9220de6862327c94966239cc Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 21 May 2024 23:59:55 -0600 Subject: [PATCH 26/61] fix a bug --- base/MAPL_SwathGridFactory.F90 | 62 +++++++++++++++++++--------------- 1 file changed, 34 insertions(+), 28 deletions(-) diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index e89c6b0fd8d4..17a9e4972dcf 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -169,11 +169,11 @@ function make_new_grid(this, unusable, rc) result(grid) _UNUSED_DUMMY(unusable) - !!if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: bf this%create_basic_grid' + if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: bf this%create_basic_grid' grid = this%create_basic_grid(_RC) - !!if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%create_basic_grid' + if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%create_basic_grid' call this%add_horz_coordinates_from_file(grid,_RC) - !!if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%add_horz_coordinates_from_file' + if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%add_horz_coordinates_from_file' _RETURN(_SUCCESS) end function make_new_grid @@ -1173,44 +1173,50 @@ subroutine generate_newnxy(this,unusable,rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: n - + integer :: pet_count + integer :: j, fac + _UNUSED_DUMMY(unusable) + pet_count = this%nx * this%ny n = this%im_world/this%nx if (n < 2) then - this%nx = generate_new_decomp(this%im_world,this%nx) - deallocate(this%ims) - allocate(this%ims(0:this%nx-1)) - call MAPL_DecomposeDim(this%im_world, this%ims, this%nx) + do j = int(sqrt(real(this%im_world))), 1, -1 + if ( mod(pet_count, j) == 0 .and. this%im_world/j >= 2 ) then + exit + end if + end do + this%nx = j + this%ny = pet_count/j end if + n = this%jm_world/this%ny if (n < 2) then - this%ny = generate_new_decomp(this%jm_world,this%ny) - deallocate(this%jms) - allocate(this%jms(0:this%ny-1)) - call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny) + do j = int(sqrt(real(this%jm_world))), 1, -1 + if ( mod(pet_count, j) == 0 .and. this%jm_world/j >=2 ) then + exit + end if + end do + this%ny = j + this%nx = pet_count/j end if - _RETURN(_SUCCESS) + if ( this%im_world/this%nx < 2 .and. this%jm_world/this%ny < 2 ) then + _FAIL ('Algorithm failed') + end if - end subroutine generate_newnxy + deallocate(this%ims) + allocate(this%ims(0:this%nx-1)) + call MAPL_DecomposeDim(this%im_world, this%ims, this%nx) + deallocate(this%jms) + allocate(this%jms(0:this%ny-1)) + call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny) - function generate_new_decomp(im,nd) result(n) - integer, intent(in) :: im, nd - integer :: n - logical :: canNotDecomp + _RETURN(_SUCCESS) - canNotDecomp = .true. - n = nd - do while(canNotDecomp) - if ( (im/n) < 2) then - n = n/2 - else - canNotDecomp = .false. - end if - enddo - end function generate_new_decomp + end subroutine generate_newnxy + subroutine init_halo(this, unusable, rc) class (SwathGridFactory), target, intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable From aff31f6c1e58b8a01c9d0859c1f7c1829518c42c Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 22 May 2024 00:22:48 -0600 Subject: [PATCH 27/61] clean up --- base/MAPL_SwathGridFactory.F90 | 45 +++++----------------------------- 1 file changed, 6 insertions(+), 39 deletions(-) diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index 17a9e4972dcf..3c05471d7c2c 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -169,12 +169,8 @@ function make_new_grid(this, unusable, rc) result(grid) _UNUSED_DUMMY(unusable) - if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: bf this%create_basic_grid' grid = this%create_basic_grid(_RC) - if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%create_basic_grid' call this%add_horz_coordinates_from_file(grid,_RC) - if (mapl_am_I_root()) write(6,*) 'MAPL_SwathGridFactory.F90: af this%add_horz_coordinates_from_file' - _RETURN(_SUCCESS) end function make_new_grid @@ -482,7 +478,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _ASSERT (this%lm /= MAPL_UNDEFINED_INTEGER, 'LM: is undefined in swath grid') call lgr%debug(' %a %a', 'CurrTime =', trim(tmp)) - call lgr%debug(' %a %i5 %i5', 'nx,ny =', this%nx, this%ny) + call lgr%debug(' %a %i5 %i5', 'nx, ny = ', this%nx, this%ny) if ( index(tmp, 'T') /= 0 .OR. index(tmp, '-') /= 0 ) then call ESMF_TimeSet(currTime, timeString=tmp, _RC) @@ -717,13 +713,6 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc else call get_multi_integer(this%jms, 'JMS:', _RC) endif - - if (mapl_am_i_root()) then -! write(6,*) 'ims ', this%ims -! write(6,*) 'jms ', this%jms - end if - - ! ims is set at here call this%check_and_fill_consistency(_RC) @@ -866,33 +855,12 @@ subroutine check_and_fill_consistency(this, unusable, rc) call verify(this%nx, this%im_world, this%ims, rc=status) call verify(this%ny, this%jm_world, this%jms, rc=status) - - if (mapl_am_i_root()) then - write(6,*) 'bf check fill consistency' - write(6,*) 'ims ', this%ims - write(6,*) 'jms ', this%jms - write(6,*) 'im_world ', this%im_world - write(6,*) 'jm_world ', this%jm_world - end if - if (.not.this%force_decomposition) then verify_decomp = this%check_decomposition(_RC) if ( (.not.verify_decomp) ) then call this%generate_newnxy(_RC) - write(6,*) 'af this%generate_newnxy' end if end if - - - if (mapl_am_i_root()) then - write(6,*) 'af check fill consistency' - write(6,*) 'ims ', this%ims - write(6,*) 'jms ', this%jms - write(6,*) 'im_world ', this%im_world - write(6,*) 'jm_world ', this%jm_world - end if - - _RETURN(_SUCCESS) contains @@ -1173,9 +1141,8 @@ subroutine generate_newnxy(this,unusable,rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: n - integer :: pet_count - integer :: j, fac - + integer :: j, pet_count + _UNUSED_DUMMY(unusable) pet_count = this%nx * this%ny @@ -1189,7 +1156,7 @@ subroutine generate_newnxy(this,unusable,rc) this%nx = j this%ny = pet_count/j end if - + n = this%jm_world/this%ny if (n < 2) then do j = int(sqrt(real(this%jm_world))), 1, -1 @@ -1210,13 +1177,13 @@ subroutine generate_newnxy(this,unusable,rc) call MAPL_DecomposeDim(this%im_world, this%ims, this%nx) deallocate(this%jms) allocate(this%jms(0:this%ny-1)) - call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny) + call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny) _RETURN(_SUCCESS) end subroutine generate_newnxy - + subroutine init_halo(this, unusable, rc) class (SwathGridFactory), target, intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable From bcaf7791e732bcbbf1ed57dc6eb0d59852e7ac7a Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 22 May 2024 08:10:06 -0600 Subject: [PATCH 28/61] Add a note --- CHANGELOG.md | 1 + base/MAPL_SwathGridFactory.F90 | 14 +++++++------- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1398dc486161..16a8ec8bc274 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 ### Changed +- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (NX*NY=Ncore) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - ESMA_cmake v3.45.1 diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index 3c05471d7c2c..ed87cf06bec3 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -1148,9 +1148,9 @@ subroutine generate_newnxy(this,unusable,rc) pet_count = this%nx * this%ny n = this%im_world/this%nx if (n < 2) then - do j = int(sqrt(real(this%im_world))), 1, -1 + do j = this%im_world/2, 1, -1 if ( mod(pet_count, j) == 0 .and. this%im_world/j >= 2 ) then - exit + exit ! found a decomposition end if end do this%nx = j @@ -1159,23 +1159,23 @@ subroutine generate_newnxy(this,unusable,rc) n = this%jm_world/this%ny if (n < 2) then - do j = int(sqrt(real(this%jm_world))), 1, -1 + do j = this%jm_world/2, 1, -1 if ( mod(pet_count, j) == 0 .and. this%jm_world/j >=2 ) then - exit + exit ! found a decomposition end if end do this%ny = j this%nx = pet_count/j end if - if ( this%im_world/this%nx < 2 .and. this%jm_world/this%ny < 2 ) then + if ( this%im_world/this%nx < 2 .OR. this%jm_world/this%ny < 2 ) then _FAIL ('Algorithm failed') end if - deallocate(this%ims) + if (allocated(this%ims)) deallocate(this%ims) allocate(this%ims(0:this%nx-1)) call MAPL_DecomposeDim(this%im_world, this%ims, this%nx) - deallocate(this%jms) + if (allocated(this%jms)) deallocate(this%jms) allocate(this%jms(0:this%ny-1)) call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny) From 9a1094b400dbcf2b5b85c70811bbcc22207a1266 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 22 May 2024 10:57:09 -0600 Subject: [PATCH 29/61] put debug statement in the right position --- base/MAPL_SwathGridFactory.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index ed87cf06bec3..f931fe52a12f 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -478,7 +478,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _ASSERT (this%lm /= MAPL_UNDEFINED_INTEGER, 'LM: is undefined in swath grid') call lgr%debug(' %a %a', 'CurrTime =', trim(tmp)) - call lgr%debug(' %a %i5 %i5', 'nx, ny = ', this%nx, this%ny) + if ( index(tmp, 'T') /= 0 .OR. index(tmp, '-') /= 0 ) then call ESMF_TimeSet(currTime, timeString=tmp, _RC) @@ -715,6 +715,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc endif ! ims is set at here call this%check_and_fill_consistency(_RC) + call lgr%debug(' %a %i5 %i5', 'nx, ny (check_and_fill_consistency) = ', this%nx, this%ny) _RETURN(_SUCCESS) From 8a23b743833c2a7884b5ad97b0521bed26503c0b Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 22 May 2024 13:02:45 -0600 Subject: [PATCH 30/61] test remove mpi barrier --- gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 6201f50e2754..6e4dbb76ae2c 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -354,7 +354,6 @@ call ESMF_FieldHaloStore (fieldI4, routehandle=RH_halo, _RC) call ESMF_FieldHalo (fieldI4, routehandle=RH_halo, _RC) - call ESMF_VMBarrier (vm, _RC) k=0 do i=eLB(1), eUB(1) @@ -411,7 +410,7 @@ lons(i) = lons_ptr (ix, jx) lats(i) = lats_ptr (ix, jx) end do - call ESMF_VMBarrier (vm, _RC) + iroot=0 if (mapl_am_i_root()) then @@ -626,7 +625,7 @@ iy = this%index_mask(2,j) p_dst_2d(j) = p_src_2d(ix, iy) end do - call MPI_Barrier(mpic, status) +!! call MPI_Barrier(mpic, status) nsend = nx call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& @@ -648,7 +647,7 @@ p_dst_3d(m) = p_src_3d(ix, iy, k) end do end do - call MPI_Barrier(mpic, status) +!! call MPI_Barrier(mpic, status) !! write(6,'(2x,a,2x,i5,3x,10f8.1)') 'pet, p_dst_3d(j)', mypet, p_dst_3d(::10) nsend = nx * nz call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & From 0c547048109f178003503056eb18a45536f9db8b Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 23 May 2024 09:16:35 -0600 Subject: [PATCH 31/61] - add timer to put_var for 2D and 3D var in station and mask sampler - removed chunksizes in station sampler --- gridcomps/History/MAPL_HistoryGridComp.F90 | 4 ++-- gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 | 5 ++++- .../History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 6 ++++++ .../History/Sampler/MAPL_StationSamplerMod.F90 | 13 +++++++++++-- 4 files changed, 23 insertions(+), 5 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index d8a2d6321449..c287dae7b07d 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2426,10 +2426,10 @@ subroutine Initialize ( gc, import, dumexport, clock, 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 - list(n)%mask_sampler = MaskSamplerGeosat(cfg,string,clock,_RC) + list(n)%mask_sampler = MaskSamplerGeosat(cfg,string,clock,genstate=GENSTATE,_RC) call list(n)%mask_sampler%initialize(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) elseif (list(n)%sampler_spec == 'station') then - list(n)%station_sampler = StationSampler (list(n)%bundle, trim(list(n)%stationIdFile), nskip_line=list(n)%stationSkipLine, _RC) + list(n)%station_sampler = StationSampler (list(n)%bundle, trim(list(n)%stationIdFile), nskip_line=list(n)%stationSkipLine, genstate=GENSTATE, _RC) call list(n)%station_sampler%add_metadata_route_handle(items=list(n)%items,bundle=list(n)%bundle,timeinfo=list(n)%timeInfo,vdata=list(n)%vdata,_RC) else global_attributes = list(n)%global_atts%define_collection_attributes(_RC) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 index 5674a1b2f1ca..c1dc6e1bbd96 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 @@ -20,6 +20,7 @@ module MaskSamplerGeosatMod use MPI use pFIO_FileMetadataMod, only : FileMetadata use pFIO_NetCDF4_FileFormatterMod, only : NetCDF4_FileFormatter + use MAPL_GenericMod, only : MAPL_MetaComp, MAPL_TimerOn, MAPL_TimerOff use, intrinsic :: iso_fortran_env, only: REAL32 use, intrinsic :: iso_fortran_env, only: REAL64 use pflogger, only: Logger, logging @@ -76,6 +77,7 @@ module MaskSamplerGeosatMod real(kind=REAL64), allocatable :: lats(:) integer, allocatable :: recvcounts(:) integer, allocatable :: displs(:) + type(MAPL_MetaComp), pointer :: GENSTATE real(kind=ESMF_KIND_R8), pointer:: obsTime(:) real(kind=ESMF_KIND_R8), allocatable:: t_alongtrack(:) @@ -104,11 +106,12 @@ module MaskSamplerGeosatMod interface - module function MaskSamplerGeosat_from_config(config,string,clock,rc) result(mask) + module function MaskSamplerGeosat_from_config(config,string,clock,GENSTATE,rc) result(mask) type(MaskSamplerGeosat) :: mask type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: string type(ESMF_Clock), intent(in) :: clock + type(MAPL_MetaComp), pointer, intent(in), optional :: GENSTATE integer, optional, intent(out) :: rc end function MaskSamplerGeosat_from_config diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 6201f50e2754..e72b3783000b 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -27,6 +27,8 @@ mask%clock=clock mask%grid_file_name='' + if (present(GENSTATE)) mask%GENSTATE => GENSTATE + call ESMF_ClockGet ( clock, CurrTime=currTime, _RC ) if (mapl_am_I_root()) write(6,*) 'string', string @@ -631,10 +633,12 @@ call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& iroot, mpic, ierr ) + call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(item%xname,p_dst_2d_full,& start=[1,this%obs_written],count=[this%npt_mask_tot,1],_RC) end if + call MAPL_TimerOff(this%GENSTATE,"put2D") else if (rank==3) then call ESMF_FieldGet(src_field,farrayptr=p_src_3d,_RC) call ESMF_FieldGet(src_field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) @@ -654,6 +658,7 @@ call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & p_dst_3d_full, recvcounts_3d, displs_3d, MPI_REAL,& iroot, mpic, ierr ) + call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then allocate(arr(nz, this%npt_mask_tot), _STAT) arr=reshape(p_dst_3d_full,[nz,this%npt_mask_tot],order=[1,2]) @@ -662,6 +667,7 @@ !note: lev,station,time deallocate(arr, _STAT) end if + call MAPL_TimerOff(this%GENSTATE,"put3D") else _FAIL('grid2LS regridder: rank > 3 not implemented') end if diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 096d39d0cf9f..d92d54c64851 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -11,6 +11,7 @@ module StationSamplerMod use MAPL_BaseMod use MAPL_CommsMod use MAPL_LocstreamRegridderMod + use MAPL_GenericMod, only : MAPL_MetaComp, MAPL_TimerOn, MAPL_TimerOff use MPI, only : MPI_INTEGER, MPI_REAL, MPI_REAL8 use, intrinsic :: iso_fortran_env, only: INT64 use, intrinsic :: iso_fortran_env, only: REAL32 @@ -31,6 +32,7 @@ module StationSamplerMod type(GriddedIOitemVector) :: items logical :: do_vertical_regrid logical :: level_by_level + type(MAPL_MetaComp), pointer :: GENSTATE integer :: nstation integer, allocatable :: station_id(:) @@ -64,13 +66,14 @@ module StationSamplerMod contains - function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(sampler) + function new_StationSampler_readfile (bundle, filename, nskip_line, GENSTATE, rc) result(sampler) use pflogger, only : Logger, logging implicit none type(StationSampler) :: sampler type(ESMF_FieldBundle), intent(in) :: bundle character(len=*), intent(in) :: filename integer, optional, intent(in) :: nskip_line + type(MAPL_MetaComp), pointer, intent(in), optional :: GENSTATE integer, optional, intent(out) :: rc type(ESMF_VM) :: vm @@ -241,6 +244,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, rc) result(s allocate(sampler%elevs(nstation), _STAT) end if sampler%index_name_x = 'station_index' + if (present(GENSTATE)) sampler%GENSTATE => GENSTATE !__ 2. create LocStreamFactory, then LS_rt including route_handle @@ -457,7 +461,8 @@ subroutine create_metadata_variable(this,vname,rc) case default _FAIL('unsupported rank') end select - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=chunksizes) + ! v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=chunksizes) + v = variable(type=PFIO_REAL32,dimensions=trim(vdims)) call v%add_attribute('units',trim(units)) call v%add_attribute('long_name',trim(long_name)) @@ -608,10 +613,12 @@ subroutine append_file(this,current_time,rc) ! end do ! end if + call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(trim(item%xname),p_rt_2d,& start=[1,this%obs_written],count=[this%nstation,1],_RC) end if + call MAPL_TimerOff(this%GENSTATE,"put2D") case(3) ! -- CS-> LS_ds; ds->chunk; gather @@ -656,12 +663,14 @@ subroutine append_file(this,current_time,rc) ! end if ! if (mapl_am_i_root()) write(6,*) 'regrid + gatherV in 3D' + call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then nz=size(p_rt_3d,1); nx=size(p_rt_3d,2) call this%formatter%put_var(trim(item%xname),p_rt_3d,& start=[1,1,this%obs_written],count=[nz,nx,1],_RC) !note: lev,station,time end if + call MAPL_TimerOff(this%GENSTATE,"put3D") case default _FAIL('grid2LS regridder: rank > 3 not implemented') end select From d8896c1b60de6e2fce21a41c724563f1cafd82c2 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 23 May 2024 13:10:09 -0400 Subject: [PATCH 32/61] - remove chunksizes in mask sampler --- gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index e72b3783000b..7faee14cd798 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -529,11 +529,11 @@ endif if (field_rank==2) then vdims = "mask_index,time" - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[this%npt_mask_tot,1]) + v = variable(type=PFIO_REAL32,dimensions=trim(vdims)) else if (field_rank==3) then vdims = "lev,mask_index,time" call ESMF_FieldGet(field,ungriddedLBound=lb,ungriddedUBound=ub,_RC) - v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=[ub(1)-lb(1)+1,1,1]) + v = variable(type=PFIO_REAL32,dimensions=trim(vdims)) end if call v%add_attribute('units', trim(units)) call v%add_attribute('long_name', trim(long_name)) From 38a2cb1eb35bee7d073f6174d5e0a7b3028369d1 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 23 May 2024 11:35:33 -0600 Subject: [PATCH 33/61] - delete keyword accumulate in mask sampler --- gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 | 6 +++--- gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 7 ++----- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 index c1dc6e1bbd96..8fc982729673 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 @@ -94,7 +94,7 @@ module MaskSamplerGeosatMod procedure :: add_metadata procedure :: create_file_handle procedure :: close_file_handle - procedure :: append_file => regrid_accumulate_append_file + procedure :: append_file => regrid_append_file ! procedure :: create_new_bundle procedure :: create_grid => create_Geosat_grid_find_mask procedure :: compute_time_for_current @@ -153,11 +153,11 @@ module subroutine close_file_handle(this,rc) integer, optional, intent(out) :: rc end subroutine close_file_handle - module subroutine regrid_accumulate_append_file(this,current_time,rc) + module subroutine regrid_append_file(this,current_time,rc) class(MaskSamplerGeosat), intent(inout) :: this type(ESMF_Time), intent(inout) :: current_time integer, optional, intent(out) :: rc - end subroutine regrid_accumulate_append_file + end subroutine regrid_append_file module function compute_time_for_current(this,current_time,rc) result(rtime) class(MaskSamplerGeosat), intent(inout) :: this diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index f4156fc9f0b2..df7917cff814 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -326,7 +326,6 @@ obs_lats = lats_ds * MAPL_DEGREES_TO_RADIANS_R8 nx = size ( lons_ds ) allocate ( II(nx), JJ(nx), _STAT ) - call MPI_Barrier(mpic, status) call MAPL_GetHorzIJIndex(nx,II,JJ,lonR8=obs_lons,latR8=obs_lats,grid=grid,_RC) call ESMF_VMBarrier (vm, _RC) @@ -547,7 +546,7 @@ end procedure add_metadata - module procedure regrid_accumulate_append_file + module procedure regrid_append_file ! implicit none integer :: status @@ -627,7 +626,6 @@ iy = this%index_mask(2,j) p_dst_2d(j) = p_src_2d(ix, iy) end do -!! call MPI_Barrier(mpic, status) nsend = nx call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& @@ -651,7 +649,6 @@ p_dst_3d(m) = p_src_3d(ix, iy, k) end do end do -!! call MPI_Barrier(mpic, status) !! write(6,'(2x,a,2x,i5,3x,10f8.1)') 'pet, p_dst_3d(j)', mypet, p_dst_3d(::10) nsend = nx * nz call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & @@ -676,7 +673,7 @@ end do _RETURN(_SUCCESS) - end procedure regrid_accumulate_append_file + end procedure regrid_append_file From 953ff8e7d4761bd339c8c136ac13f9b9b4bd1a7d Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 23 May 2024 22:36:01 -0600 Subject: [PATCH 34/61] - refine regrid in station sampler --- .../Sampler/MAPL_StationSamplerMod.F90 | 51 ++++++++++++------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index d92d54c64851..73d24a9efd29 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -335,7 +335,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) integer :: lb(ESMF_MAXDIM) logical :: do_vertical_regrid integer :: status - integer :: i + integer :: i, lm character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: var_name, long_name, units, vdims @@ -509,9 +509,12 @@ subroutine append_file(this,current_time,rc) integer :: n0, nx, nx2 integer :: na, nb, nx_sum, nsend, nsend_v - type(ESMF_Field) :: field_ds_2d, field_ds_3d - type(ESMF_Field) :: field_chunk_2d, field_chunk_3d - type(ESMF_Field) :: field_rt_2d, field_rt_3d + ! intermediate fields as placeholder + type(ESMF_Field) :: field_ds_2d + type(ESMF_Field) :: field_ds_3d + type(ESMF_Field) :: field_chunk_2d + type(ESMF_Field) :: field_chunk_3d + integer :: sec integer, allocatable :: ix(:) ! counter for each obs(k)%nobs_epoch @@ -538,16 +541,10 @@ subroutine append_file(this,current_time,rc) !__ 2. regrid + put_var: ! ungridded_dim from src to dst [regrid] ! - lm = this%vdata%lm - field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) - field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) - dst_field = ESMF_FieldCreate (this%LS_ds, name='dst_field', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - - ! caution about zero-sized array for MPI ! redist nx_sum = this%nstation + lm = this%vdata%lm call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, petCount=petCount, localPet=mypet, _RC) @@ -568,6 +565,7 @@ subroutine append_file(this,current_time,rc) displs(i) = displs(i-1) + recvcount(i-1) end do + nsend_v = nsend * lm ! vertical allocate (recvcount_v, source = recvcount * lm ) allocate (displs_v, source = displs * lm ) @@ -588,11 +586,24 @@ subroutine append_file(this,current_time,rc) end if + !__ Aux. field + ! + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) + field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) + dst_field = ESMF_FieldCreate (this%LS_ds, name='dst_field', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + + field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + + iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() if (item%itemType == ItemTypeScalar) then - +!! if (mapl_am_i_root()) write(6,*) 'item%xname=', trim(item%xname) call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) call ESMF_FieldGet(src_field,rank=rank,_RC) select case (rank) @@ -600,6 +611,7 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_2d,_RC) call ESMF_FieldGet(field_ds_2d,localDE=0,farrayptr=p_ds_2d,_RC) call ESMF_FieldGet(field_chunk_2d,localDE=0,farrayPtr=p_chunk_2d,_RC) + p_ds_2d = 0.0 call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) @@ -625,18 +637,15 @@ subroutine append_file(this,current_time,rc) ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) call ESMF_FieldGet(dst_field,localDE=0,farrayptr=p_dst_3d,_RC) + p_dst_3d = 0.0 call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) - field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) ! p_ds_3d(lm, nx) p_ds_3d = reshape(p_dst_3d, shape(p_ds_3d), order=[2,1]) - call ESMF_FieldRedist(field_ds_3d, field_chunk_3d, this%RH, _RC) + call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) if (this%level_by_level) then ! p_chunk_3d (lm, nx) @@ -653,8 +662,6 @@ subroutine append_file(this,current_time,rc) p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) end if - call ESMF_FieldDestroy(field_ds_3d,noGarbage=.true.,_RC) - call ESMF_FieldDestroy(field_chunk_3d,noGarbage=.true.,_RC) ! if (mapl_am_i_root()) then ! do j=1, nx_sum, 500 @@ -681,6 +688,12 @@ subroutine append_file(this,current_time,rc) call iter%next() end do + call ESMF_FieldDestroy(field_ds_2d, noGarbage=.true., _RC) + call ESMF_FieldDestroy(field_chunk_2d, noGarbage=.true., _RC) + call ESMF_FieldDestroy(field_ds_3d, noGarbage=.true., _RC) + call ESMF_FieldDestroy(field_chunk_3d, noGarbage=.true., _RC) + call ESMF_FieldDestroy(dst_field, noGarbage=.true., _RC) + _RETURN(_SUCCESS) end subroutine append_file From d078595260ba6b51b84fced642369e20c56ce3bd Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 24 May 2024 16:20:51 -0400 Subject: [PATCH 35/61] add new option to Regrid_Util.x --- Apps/Regrid_Util.F90 | 8 ++++++-- CHANGELOG.md | 1 + griddedio/FieldBundleRead.F90 | 15 ++++++++++++--- 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/Apps/Regrid_Util.F90 b/Apps/Regrid_Util.F90 index 5abbcaddfc16..8b4810c4d073 100644 --- a/Apps/Regrid_Util.F90 +++ b/Apps/Regrid_Util.F90 @@ -26,6 +26,7 @@ module regrid_util_support_mod integer :: deflate, shave integer :: quantize_algorithm integer :: quantize_level + logical :: use_weights contains procedure :: create_grid procedure :: process_command_line @@ -97,6 +98,7 @@ subroutine process_command_line(this,rc) this%deflate=0 this%quantize_algorithm=1 this%quantize_level=0 + this%use_weights = .false. nargs = command_argument_count() do i=1,nargs call get_command_argument(i,str) @@ -159,6 +161,8 @@ subroutine process_command_line(this,rc) case('-quantize_level') call get_command_argument(i+1,astr) read(astr,*)this%quantize_level + case('-file_weights') + this%use_weights = .true. case('--help') if (mapl_am_I_root()) then @@ -413,9 +417,9 @@ subroutine main() if (mapl_am_i_root()) write(*,*)'processing timestep from '//trim(filename) time = tSeries(i) if (support%onlyvars) then - call MAPL_Read_bundle(bundle,trim(filename),time=time,regrid_method=support%regridMethod,only_vars=support%vars,_RC) + call MAPL_Read_bundle(bundle,trim(filename),time=time,regrid_method=support%regridMethod,only_vars=support%vars,file_weights=support%use_weights, _RC) else - call MAPL_Read_bundle(bundle,trim(filename),time=time,regrid_method=support%regridMethod,_RC) + call MAPL_Read_bundle(bundle,trim(filename),time=time,regrid_method=support%regridMethod,file_weights=support%use_weights, _RC) end if call t_prof%stop("Read") diff --git a/CHANGELOG.md b/CHANGELOG.md index 16a8ec8bc274..33c9f9cf8461 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights - If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob - Add GNU UFS-like CI test diff --git a/griddedio/FieldBundleRead.F90 b/griddedio/FieldBundleRead.F90 index 220058566215..fba7adb6c341 100644 --- a/griddedio/FieldBundleRead.F90 +++ b/griddedio/FieldBundleRead.F90 @@ -21,6 +21,7 @@ module MAPL_ESMFFieldBundleRead use MAPL_SimpleAlarm use MAPL_StringTemplate use gFTL_StringVector + use MAPL_RegridMethods use, intrinsic :: iso_fortran_env, only: REAL32 implicit none private @@ -152,7 +153,7 @@ subroutine MAPL_create_bundle_from_metdata_id(bundle,metadata_id,file_name,only_ end subroutine MAPL_create_bundle_from_metdata_id - subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread,file_override,rc) + subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread,file_override,file_weights,rc) type(ESMF_FieldBundle), intent(inout) :: bundle character(len=*), intent(in) :: file_tmpl type(ESMF_Time), intent(in) :: time @@ -160,10 +161,11 @@ subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread integer, optional, intent(in) :: regrid_method logical, optional, intent(in) :: noread character(len=*), optional, intent(in) :: file_override + logical, optional, intent(in) :: file_weights integer, optional, intent(out) :: rc integer :: status - integer :: num_fields, metadata_id, collection_id, time_index, i + integer :: num_fields, metadata_id, collection_id, time_index, i, regrid_hints type(MAPL_GriddedIO) :: cfio character(len=ESMF_MAXPATHLEN) :: file_name type(MAPLDataCollection), pointer :: collection => null() @@ -181,7 +183,7 @@ subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread metadata_id = MAPL_DataAddCollection(trim(file_tmpl)) collection => DataCollections%at(metadata_id) if (present(file_override)) file_name = file_override - + metadata => collection%find(trim(file_name), _RC) call metadata%get_time_info(timeVector=time_series,rc=status) _VERIFY(status) @@ -221,6 +223,13 @@ subroutine MAPL_read_bundle(bundle,file_tmpl,time,only_vars,regrid_method,noread cfio=MAPL_GriddedIO(output_bundle=bundle,metadata_collection_id=metadata_id,read_collection_id=collection_id,items=items) call cfio%set_param(regrid_method=regrid_method) + if (present(file_weights)) then + if (file_weights) then + regrid_hints = 0 + regrid_hints = IOR(regrid_hints,REGRID_HINT_FILE_WEIGHTS) + call cfio%set_param(regrid_hints=regrid_hints) + end if + end if call cfio%request_data_from_file(trim(file_name),timeindex=time_index,rc=status) _VERIFY(status) call i_clients%done_collective_prefetch() From e7180e5c87e53216e7374681242e168498fd5a48 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Fri, 31 May 2024 12:21:31 -0400 Subject: [PATCH 36/61] Replace "*" with command option for "LONG_NAME" --- Apps/MAPL_GridCompSpecs_ACG.py | 370 ++++++++++++++++++--------------- 1 file changed, 208 insertions(+), 162 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 7e1c36c154af..e9ff3e4b26b9 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -4,37 +4,32 @@ import os import csv from collections import namedtuple +from collections.abc import Iterable, Sequence import operator from functools import partial from enum import Enum +################################# CONSTANTS #################################### SUCCESS = 0 - CATEGORIES = ("IMPORT","EXPORT","INTERNAL") +LONGNAME_GLOB_PREFIX = "longname_glob_prefix" +# constants for logicals +TRUE_VALUE = '.true.' +FALSE_VALUE = '.false.' +TRUE_VALUES = {'t', 'true', 'yes', 'y', 'si', 'oui', 'sim'} +FALSE_VALUES = {'f', 'false', 'no', 'n', 'no', 'non', 'nao'} -"""Helper functions -lambda (anonymous) functions are simple functions (usually one line), -of the form: - lambda x, y, z, ...: -where 'x, y, z, ...' represents one or more arguments (It's a tuple.) -They are quite handy for processing sequences (think: list, tuples, sets) -They are used here for emitting values, as well. -""" - -# Return the value -identity_emit = lambda value: value -# Return value in quotes -string_emit = lambda value: ("'" + value + "'") if value else None -# Return value in brackets -array_emit = lambda value: ('[' + value + ']') if value else None -lstripped = lambda s: s.lower().strip(' .') +# constants used for Option.DIMS and computing rank +DIMS_OPTIONS = [('MAPL_DimsVertOnly', 1, 'z'), ('MAPL_DimsHorzOnly', 2, 'xy'), ('MAPL_DimsHorzVert', 3, 'xyz')] +RANKS = dict([(entry, rank) for entry, rank, _ in DIMS_OPTIONS]) -# emit function for character arrays -string_array_emit = lambda value: make_string_array(value) if value else None +############################### HELPER FUNCTIONS ############################### def make_string_array(s): """ Returns a string representing a Fortran character array """ + rm_quotes = lambda s: s.strip().strip('"\'').strip() + add_quotes = lambda s: "'" + s + "'" ss = s.strip() if ',' in ss: ls = [s.strip() for s in s.strip().split(',')] @@ -46,38 +41,107 @@ def make_string_array(s): ss = ','.join([add_quotes(s) for s in ls]) return f"[character(len={n}) :: {ss}]" -rm_quotes = lambda s: s.strip().strip('"\'').strip() -add_quotes = lambda s: "'" + s + "'" - -mangle_name = lambda name: string_emit(name.replace("*","'//trim(comp_name)//'")) if name else None -make_internal_name = lambda name: name.replace('*','') if name else None - def make_entry_emit(dictionary): """ Returns a emit function that looks up the value in dictionary """ return lambda key: dictionary[key] if key in dictionary else None -# constants used for Option.DIMS -DIMS_OPTIONS = [('MAPL_DimsVertOnly', 1, 'z'), ('MAPL_DimsHorzOnly', 2, 'xy'), ('MAPL_DimsHorzVert', 3, 'xyz')] -DIMS_EMIT = make_entry_emit(dict([(alias, entry) for entry, _, alias in DIMS_OPTIONS])) -RANKS = dict([(entry, rank) for entry, rank, _ in DIMS_OPTIONS]) +def mangle_name_prefix(name, parameters = None): + pre = 'comp_name' + if isinstance(parameters, Iterable): + l = list(parameters) + pre = l[0] if len(l) else pre + codestring = f"'//trim({pre})//'" + return string_emit(name.replace("*",codestring)) if name else None + +def get_fortran_logical(value_in): + """ Return string representing Fortran logical from an input string """ + """ representing a logical value input """ + + try: + if value_in is None: + raise ValueError("'None' is not valid for get_fortran_logical.") + if value_in.strip().lower() in TRUE_VALUES: + val_out = TRUE_VALUE + elif value_in.strip().lower() in FALSE_VALUES: + val_out = FALSE_VALUE + else: + raise ValueError("Unrecognized logical: " + value_in) + except Exception: + raise + + return val_out + +def compute_rank(dims, ungridded): + extra_rank = len(ungridded.strip('][').split(',')) if ungridded else 0 + return RANKS[dims] + extra_rank + +def header(): + """ + Returns a standard warning that can be placed at the top of each + generated _Fortran_ include file. + """ + + return """ +! ------------------- +! W A R N I N G +! ------------------- +! +! This code fragment is automatically generated by MAPL_GridCompSpecs_ACG. +! Please DO NOT edit it. Any modification made in here will be overwritten +! next time this file is auto-generated. Instead, enter your additions +! or deletions in the .rc file in the src tree. +! + """ + +def open_with_header(filename): + f = open(filename,'w') + f.write(header()) + return f + +# callable object (function) +class ParameterizedEmitFunction: + + def __init__(self, emit, *parameter_keys): + self.emit = emit + self.parameter_keys = parameter_keys + + def __call__(self, name, parameters): + parameter_values = (parameters.get(key) for key in self.parameter_keys) + return self.emit(name, parameter_values) + +##################### EMIT functions for writing AddSpecs ###################### +# Return the value +identity_emit = lambda value: value +# Return value in quotes +string_emit = lambda value: ("'" + value + "'") if value else None +# Return value in brackets +array_emit = lambda value: ('[' + value + ']') if value else None +# Strip '.' and ' ' [SPACE] +lstripped = lambda s: s.lower().strip(' .') +# emit function for character arrays +string_array_emit = lambda value: make_string_array(value) if value else None +# mangle name for SHORT_NAME +mangle_name = lambda name: string_emit(name.replace("*","'//trim(comp_name)//'")) if name else None +# mangle name for internal use +make_internal_name = lambda name: name.replace('*','') if name else None +# emit function for LONG_NAME +mangle_longname = ParameterizedEmitFunction(mangle_name_prefix, LONGNAME_GLOB_PREFIX) +# emit for function for DIMS +DIMS_EMIT = make_entry_emit(dict([(alias, entry) for entry, _, alias in DIMS_OPTIONS])) # emit function for Option.VLOCATION VLOCATION_EMIT = make_entry_emit({'C': 'MAPL_VlocationCenter', 'E': 'MAPL_VlocationEdge', 'N': 'MAPL_VlocationNone'}) - +# emit function for Option.ADD2EXPORT +ADD2EXPORT_EMIT = make_entry_emit({'T': '.true.', 'F': '.false.'}) +# emit function for logical-valued options +logical_emit = lambda s: TRUE_VALUE if lstripped(s) in TRUE_VALUES else FALSE_VALUE if lstripped(s) in FALSE_VALUES else None # emit function for Option.RESTART RESTART_EMIT = make_entry_emit({'OPT' : 'MAPL_RestartOptional', 'SKIP' : 'MAPL_RestartSkip', 'REQ' : 'MAPL_RestartRequired', 'BOOT' : 'MAPL_RestartBoot', 'SKIPI': 'MAPL_RestartSkipInitial'}) -# emit function for logical-valued options -TRUEVALUES = {'t', 'true', 'yes', 'y', 'si', 'oui', 'sim'} -FALSEVALUES = {'f', 'false', 'no', 'n', 'no', 'non', 'nao'} -TRUE_VALUE = '.true.' -FALSE_VALUE = '.false.' -logical_emit = lambda s: TRUE_VALUE if lstripped(s) in TRUEVALUES else FALSE_VALUE if lstripped(s) in FALSEVALUES else None -# emit function for Option.ADD2EXPORT -ADD2EXPORT_EMIT = make_entry_emit({'T': '.true.', 'F': '.false.'}) +################################### OPTIONS #################################### # parent class for class Option # defines a few methods class OptionType(Enum): @@ -101,8 +165,8 @@ def get_mandatory_options(cls): 'SHORT_NAME': ('short_name', mangle_name, True), 'NAME': ('short_name', mangle_name, True), 'DIMS': ('dims', DIMS_EMIT, True), - 'LONG_NAME': ('long_name', mangle_name, True), - 'LONG NAME': ('long_name', mangle_name, True), + 'LONG_NAME': ('long_name', mangle_longname, True), + 'LONG NAME': ('long_name', mangle_longname, True), 'UNITS': ('units', string_emit, True), # OPTIONAL 'ADD2EXPORT': ('add2export', ADD2EXPORT_EMIT), @@ -146,6 +210,9 @@ def get_mandatory_options(cls): 'RANK': ('rank', None, False, False) }, type = OptionType) + +###################### RULES to test conditions on Options ##################### +# relations for rules on Options def relation(relop, lhs, rhs, values): """ Returns the result of the relop relation of lhs and rhs using values for lookups """ l = values[lhs] if isinstance(lhs, Option) else lhs @@ -203,6 +270,7 @@ def check(self, values): """ run rules on Option values """ return self.rule(values) +# These are the CURRENT RULES of Option (column) values def check_option_values(values): rules = [Rule(conditions = [(Option.DIMS, equals, 'MAPL_DimsHorzVert', 'is equal to MAPL_DimsHorzVert'), @@ -213,51 +281,9 @@ def check_option_values(values): for rule in rules: rule.check(values) -def compute_rank(dims, ungridded): - extra_rank = len(ungridded.strip('][').split(',')) if ungridded else 0 - return RANKS[dims] + extra_rank - -def digest(specs): - """ Set Option values from parsed specs """ - mandatory_options = Option.get_mandatory_options() - digested_specs = dict() - - for category in specs: - category_specs = list() # All the specs for the category - for spec in specs[category]: # spec from list - dims = None - ungridded = None - option_values = dict() # dict of option values - for column in spec: # for spec emit value - column_value = spec[column] - option = Option[column.upper()] # use column name to find Option - option_value = option(column_value) # emit value - option_values[option] = option_value # add value to dict - if option == Option.SHORT_NAME: - option_values[Option.MANGLED_NAME] = Option.MANGLED_NAME(column_value) - option_values[Option.INTERNAL_NAME] = Option.INTERNAL_NAME(column_value) - elif option == Option.DIMS: - dims = option_value - elif option == Option.UNGRIDDED: - ungridded = option_value -# MANDATORY - for option in mandatory_options: - if option not in option_values: - raise RuntimeError(option.name + " is missing from spec.") -# END MANDATORY - option_values[Option.RANK] = compute_rank(dims, ungridded) -# CHECKS HERE - try: - check_option_values(option_values) - except Exception: - raise -# END CHECKS - category_specs.append(option_values) - digested_specs[category] = category_specs - return digested_specs - ############################################################### +# MAPL_DATASPEC class class MAPL_DataSpec: """Declare and manipulate an import/export/internal specs for a MAPL Gridded component""" @@ -353,6 +379,36 @@ def emit_trailer(self, nullify=False): text = self.newline() return text + +############################ PARSE COMMAND ARGUMENTS ########################### +def get_args(): + parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') + parser.add_argument("input", action='store', + help="input filename") + parser.add_argument("-n", "--name", action="store", + help="override default grid component name derived from input filename") + parser.add_argument("-i", "--import_specs", action="store", nargs='?', + default=None, const="{component}_Import___.h", + help="override default output filename for AddImportSpec() code") + parser.add_argument("-x", "--export_specs", action="store", nargs='?', + default=None, const="{component}_Export___.h", + help="override default output filename for AddExternalSpec() code") + parser.add_argument("-p", "--internal_specs", action="store", nargs='?', + default=None, const="{component}_Internal___.h", + help="override default output filename for AddImportSpec() code") + parser.add_argument("-g", "--get-pointers", action="store", nargs='?', + default=None, const="{component}_GetPointer___.h", + help="override default output filename for get_pointer() code") + parser.add_argument("-d", "--declare-pointers", action="store", nargs='?', + const="{component}_DeclarePointer___.h", default=None, + help="override default output filename for pointer declaration code") + parser.add_argument("--" + LONGNAME_GLOB_PREFIX, dest=LONGNAME_GLOB_PREFIX, + action="store", nargs='?', default=None, + help="alternative prefix for long_name substitution") + return parser.parse_args() + + +# READ_SPECS function def read_specs(specs_filename): """Returns dict of (category: list of dict of (option name: option value) """ def csv_record_reader(csv_reader): @@ -396,88 +452,56 @@ def dataframe(reader, columns): return specs -def get_fortran_logical(value_in): - """ Return string representing Fortran logical from an input string """ - """ representing a logical value input """ - TRUE_VALUE = '.true.' - FALSE_VALUE = '.false.' - TRUE_VALUES = {TRUE_VALUE, 't', 'true', '.t.', 'yes', 'y', 'si', 'oui', 'sim'} - FALSE_VALUES = {FALSE_VALUE, 'f', 'false', '.f.', 'no', 'n', 'no', 'non', 'nao'} - - try: - if value_in is None: - raise ValueError("'None' is not valid for get_fortran_logical.") - if value_in.strip().lower() in TRUE_VALUES: - val_out = TRUE_VALUE - elif value_in.strip().lower() in FALSE_VALUES: - val_out = FALSE_VALUE - else: - raise ValueError("Unrecognized logical: " + value_in) - except Exception: - raise - - return val_out -def header(): - """ - Returns a standard warning that can be placed at the top of each - generated _Fortran_ include file. - """ - - return """ -! ------------------- -! W A R N I N G -! ------------------- -! -! This code fragment is automatically generated by MAPL_GridCompSpecs_ACG. -! Please DO NOT edit it. Any modification made in here will be overwritten -! next time this file is auto-generated. Instead, enter your additions -! or deletions in the .rc file in the src tree. -! - """ - -def open_with_header(filename): - f = open(filename,'w') - f.write(header()) - return f - -############################################# -# Main program begins here -############################################# - -if __name__ == "__main__": +# DIGEST +def digest(specs, args): + """ Set Option values from parsed specs """ + arg_dict = vars(args) + mandatory_options = Option.get_mandatory_options() + digested_specs = dict() -# Process command line arguments - parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') - parser.add_argument("input", action='store', - help="input filename") - parser.add_argument("-n", "--name", action="store", - help="override default grid component name derived from input filename") - parser.add_argument("-i", "--import_specs", action="store", nargs='?', - default=None, const="{component}_Import___.h", - help="override default output filename for AddImportSpec() code") - parser.add_argument("-x", "--export_specs", action="store", nargs='?', - default=None, const="{component}_Export___.h", - help="override default output filename for AddExternalSpec() code") - parser.add_argument("-p", "--internal_specs", action="store", nargs='?', - default=None, const="{component}_Internal___.h", - help="override default output filename for AddImportSpec() code") - parser.add_argument("-g", "--get-pointers", action="store", nargs='?', - default=None, const="{component}_GetPointer___.h", - help="override default output filename for get_pointer() code") - parser.add_argument("-d", "--declare-pointers", action="store", nargs='?', - const="{component}_DeclarePointer___.h", default=None, - help="override default output filename for pointer declaration code") - args = parser.parse_args() + for category in specs: + category_specs = list() # All the specs for the category + for spec in specs[category]: # spec from list + dims = None + ungridded = None + option_values = dict() # dict of option values + for column in spec: # for spec emit value + column_value = spec[column] + option = Option[column.upper()] # use column name to find Option + # emit value + if type(option.emit) is ParameterizedEmitFunction: + option_value = option.emit(column_value, arg_dict) + else: + option_value = option.emit(column_value) + option_values[option] = option_value # add value to dict + if option == Option.SHORT_NAME: + option_values[Option.MANGLED_NAME] = Option.MANGLED_NAME(column_value) + option_values[Option.INTERNAL_NAME] = Option.INTERNAL_NAME(column_value) + elif option == Option.DIMS: + dims = option_value + elif option == Option.UNGRIDDED: + ungridded = option_value +# MANDATORY + for option in mandatory_options: + if option not in option_values: + raise RuntimeError(option.name + " is missing from spec.") +# END MANDATORY + option_values[Option.RANK] = compute_rank(dims, ungridded) +# CHECKS HERE + try: + check_option_values(option_values) + except Exception: + raise +# END CHECKS + category_specs.append(option_values) + digested_specs[category] = category_specs -# Process blocked CSV input file - parsed_specs = read_specs(args.input) + return digested_specs + -# Emit values - try: - specs = digest(parsed_specs) - except Exception: - raise +################################# EMIT_VALUES ################################## +def emit_values(specs, args): if args.name: component = args.name @@ -526,5 +550,27 @@ def open_with_header(filename): if f_get_pointers: f_get_pointers.close() - sys.exit(SUCCESS) +############################################# +# MAIN program begins here +############################################# + +if __name__ == "__main__": +# Process command line arguments + args = get_args() + +# Process blocked CSV input file + parsed_specs = read_specs(args.input) + +# Digest specs from file to output structure + try: + specs = digest(parsed_specs, args) + + except Exception: + raise + +# Emit values + emit_values(specs, args) + +# FIN + sys.exit(SUCCESS) From 06323a431450fb19e4f66c4130c3102d9c15c62c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 4 Jun 2024 13:24:39 -0400 Subject: [PATCH 37/61] Fixes for NVHPC 24.5 --- CHANGELOG.md | 7 +- .../History/Sampler/MAPL_GeosatMaskMod.F90 | 16 ++++- .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 70 ++++++++++++++----- 3 files changed, 71 insertions(+), 22 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e62584cdc79b..4589579792ef 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,12 +10,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights -- If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob +- If file path length exceeds ESMF_MAXSTR, add `_FAIL` in subroutine fglob - Add GNU UFS-like CI test ### Changed -- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (NX*NY=Ncore) +- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (`NX*NY=Ncore`) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - ESMA_cmake v3.45.1 @@ -24,6 +24,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixes for NVHPC 24.5 + - Convert `MAPL_GeosatMaskMod` to "interface-in-both-files" submodule style + ### Removed ### Deprecated diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 index 5674a1b2f1ca..9950a572ae2c 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 @@ -88,7 +88,7 @@ module MaskSamplerGeosatMod integer :: obsfile_Te_index logical :: is_valid contains - procedure :: initialize + procedure :: initialize => initialize_ procedure :: add_metadata procedure :: create_file_handle procedure :: close_file_handle @@ -105,6 +105,9 @@ module MaskSamplerGeosatMod interface module function MaskSamplerGeosat_from_config(config,string,clock,rc) result(mask) + use BinIOMod + use pflogger, only : Logger, logging + type(MaskSamplerGeosat) :: mask type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: string @@ -112,7 +115,7 @@ module function MaskSamplerGeosat_from_config(config,string,clock,rc) result(mas integer, optional, intent(out) :: rc end function MaskSamplerGeosat_from_config - module subroutine initialize(this,items,bundle,timeInfo,vdata,reinitialize,rc) + module subroutine initialize_(this,items,bundle,timeInfo,vdata,reinitialize,rc) class(MaskSamplerGeosat), intent(inout) :: this type(GriddedIOitemVector), optional, intent(inout) :: items type(ESMF_FieldBundle), optional, intent(inout) :: bundle @@ -120,9 +123,12 @@ module subroutine initialize(this,items,bundle,timeInfo,vdata,reinitialize,rc) type(VerticalData), optional, intent(inout) :: vdata logical, optional, intent(in) :: reinitialize integer, optional, intent(out) :: rc - end subroutine initialize + end subroutine initialize_ module subroutine create_Geosat_grid_find_mask(this, rc) + use pflogger, only: Logger, logging + implicit none + class(MaskSamplerGeosat), intent(inout) :: this integer, optional, intent(out) :: rc end subroutine create_Geosat_grid_find_mask @@ -151,12 +157,16 @@ module subroutine close_file_handle(this,rc) end subroutine close_file_handle module subroutine regrid_accumulate_append_file(this,current_time,rc) + implicit none + class(MaskSamplerGeosat), intent(inout) :: this type(ESMF_Time), intent(inout) :: current_time integer, optional, intent(out) :: rc end subroutine regrid_accumulate_append_file module function compute_time_for_current(this,current_time,rc) result(rtime) + use MAPL_NetCDF, only : convert_NetCDF_DateTime_to_ESMF + class(MaskSamplerGeosat), intent(inout) :: this type(ESMF_Time), intent(in) :: current_time integer, optional, intent(out) :: rc diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 6201f50e2754..f14c7397caa5 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -5,9 +5,15 @@ implicit none contains - module procedure MaskSamplerGeosat_from_config +module function MaskSamplerGeosat_from_config(config,string,clock,rc) result(mask) use BinIOMod use pflogger, only : Logger, logging + type(MaskSamplerGeosat) :: mask + type(ESMF_Config), intent(inout) :: config + character(len=*), intent(in) :: string + type(ESMF_Clock), intent(in) :: clock + integer, optional, intent(out) :: rc + type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: epoch_frequency type(ESMF_TimeInterval) :: obs_time_span @@ -94,13 +100,21 @@ 105 format (1x,a,2x,a) 106 format (1x,a,2x,i8) - end procedure MaskSamplerGeosat_from_config +end function MaskSamplerGeosat_from_config ! !-- integrate both initialize and reinitialize ! - module procedure initialize +module subroutine initialize_(this,items,bundle,timeInfo,vdata,reinitialize,rc) + class(MaskSamplerGeosat), intent(inout) :: this + type(GriddedIOitemVector), optional, intent(inout) :: items + type(ESMF_FieldBundle), optional, intent(inout) :: bundle + type(TimeData), optional, intent(inout) :: timeInfo + type(VerticalData), optional, intent(inout) :: vdata + logical, optional, intent(in) :: reinitialize + integer, optional, intent(out) :: rc + integer :: status type(ESMF_Grid) :: grid type(variable) :: v @@ -131,12 +145,16 @@ _RETURN(_SUCCESS) - end procedure initialize +end subroutine initialize_ - module procedure create_Geosat_grid_find_mask + module subroutine create_Geosat_grid_find_mask(this, rc) use pflogger, only: Logger, logging implicit none + + class(MaskSamplerGeosat), intent(inout) :: this + integer, optional, intent(out) :: rc + type(Logger), pointer :: lgr real(ESMF_KIND_R8), pointer :: ptAT(:) type(ESMF_routehandle) :: RH @@ -453,10 +471,13 @@ iroot, mpic, ierr ) _RETURN(_SUCCESS) - end procedure create_Geosat_grid_find_mask + end subroutine create_Geosat_grid_find_mask + +module subroutine add_metadata(this,rc) + class(MaskSamplerGeosat), intent(inout) :: this + integer, optional, intent(out) :: rc -module procedure add_metadata type(variable) :: v type(ESMF_Field) :: field integer :: fieldCount @@ -543,12 +564,16 @@ deallocate (fieldNameList, _STAT) _RETURN(_SUCCESS) - end procedure add_metadata + end subroutine add_metadata - module procedure regrid_accumulate_append_file - ! + module subroutine regrid_accumulate_append_file(this,current_time,rc) implicit none + + class(MaskSamplerGeosat), intent(inout) :: this + type(ESMF_Time), intent(inout) :: current_time + integer, optional, intent(out) :: rc + ! integer :: status integer :: fieldCount integer :: ub(1), lb(1) @@ -671,11 +696,14 @@ end do _RETURN(_SUCCESS) - end procedure regrid_accumulate_append_file + end subroutine regrid_accumulate_append_file - module procedure create_file_handle + module subroutine create_file_handle(this,filename,rc) + class(MaskSamplerGeosat), intent(inout) :: this + character(len=*), intent(in) :: filename + integer, optional, intent(out) :: rc type(variable) :: v integer :: status, j real(kind=REAL64), allocatable :: x(:) @@ -703,10 +731,13 @@ ! call this%formatter%put_var('mask_name',this%mask_name,_RC) _RETURN(_SUCCESS) - end procedure create_file_handle + end subroutine create_file_handle - module procedure close_file_handle + module subroutine close_file_handle(this,rc) + class(MaskSamplerGeosat), intent(inout) :: this + integer, optional, intent(out) :: rc + integer :: status if (trim(this%ofile) /= '') then if (mapl_am_i_root()) then @@ -714,11 +745,16 @@ end if end if _RETURN(_SUCCESS) - end procedure close_file_handle + end subroutine close_file_handle - module procedure compute_time_for_current + module function compute_time_for_current(this,current_time,rc) result(rtime) use MAPL_NetCDF, only : convert_NetCDF_DateTime_to_ESMF + class(MaskSamplerGeosat), intent(inout) :: this + type(ESMF_Time), intent(in) :: current_time + integer, optional, intent(out) :: rc + real(kind=ESMF_KIND_R8) :: rtime + integer :: status type(ESMF_TimeInterval) :: t_interval class(Variable), pointer :: var @@ -744,7 +780,7 @@ rtime = rtime_1d(1) _RETURN(_SUCCESS) - end procedure compute_time_for_current + end function compute_time_for_current From 584c9fd315ec5d40ce201e2a52b8c2c214fb0d97 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 4 Jun 2024 13:44:37 -0400 Subject: [PATCH 38/61] Add ifdef workaround --- docs/tutorial/driver_app/Example_Driver.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/tutorial/driver_app/Example_Driver.F90 b/docs/tutorial/driver_app/Example_Driver.F90 index f974d002a624..c4c85f4949e5 100644 --- a/docs/tutorial/driver_app/Example_Driver.F90 +++ b/docs/tutorial/driver_app/Example_Driver.F90 @@ -5,6 +5,10 @@ program Example_Driver use MPI use MAPL +#ifdef __NVCOMPILER + ! Needed by NVIDIA but breaks Intel (see https://github.com/GEOS-ESM/MAPL/pull/2664) + use mapl_CapOptionsMod, only: MAPL_CapOptions +#endif implicit none type (MAPL_Cap) :: cap From a034547505bd43e12321bcfd10bdcf8860abc686 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 5 Jun 2024 13:02:26 -0400 Subject: [PATCH 39/61] Modify CHANGELOG.md --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e62584cdc79b..f69bfcc4ace3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,8 +10,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights -- If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob +- If file path length exceeds ESMF_MAXSTR, add \_FAIL in subroutine fglob - Add GNU UFS-like CI test +- Add capability to mangle `LONG_NAME in ACG with a different prefix ### Changed From 661b83d29f08880a2996c3eefaf5bc86d730e0ae Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 5 Jun 2024 15:35:46 -0400 Subject: [PATCH 40/61] Fix bug with longname_glob_prefix setting --- Apps/MAPL_GridCompSpecs_ACG.py | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index e9ff3e4b26b9..597665d2bb00 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -4,7 +4,7 @@ import os import csv from collections import namedtuple -from collections.abc import Iterable, Sequence +from collections.abc import Sequence import operator from functools import partial @@ -47,9 +47,8 @@ def make_entry_emit(dictionary): def mangle_name_prefix(name, parameters = None): pre = 'comp_name' - if isinstance(parameters, Iterable): - l = list(parameters) - pre = l[0] if len(l) else pre + if isinstance(parameters, Sequence): + pre = parameters[0] if parameters[0] else pre codestring = f"'//trim({pre})//'" return string_emit(name.replace("*",codestring)) if name else None From a5817e11a4fd9e8234bcaa5dbba5e0e0766df467 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 6 Jun 2024 11:47:08 -0400 Subject: [PATCH 41/61] Make parameters into a tuple --- Apps/MAPL_GridCompSpecs_ACG.py | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 597665d2bb00..13d113da3787 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -4,7 +4,6 @@ import os import csv from collections import namedtuple -from collections.abc import Sequence import operator from functools import partial @@ -47,7 +46,7 @@ def make_entry_emit(dictionary): def mangle_name_prefix(name, parameters = None): pre = 'comp_name' - if isinstance(parameters, Sequence): + if isinstance(parameters, tuple): pre = parameters[0] if parameters[0] else pre codestring = f"'//trim({pre})//'" return string_emit(name.replace("*",codestring)) if name else None @@ -105,7 +104,7 @@ def __init__(self, emit, *parameter_keys): self.parameter_keys = parameter_keys def __call__(self, name, parameters): - parameter_values = (parameters.get(key) for key in self.parameter_keys) + parameter_values = tuple(parameters.get(key) for key in self.parameter_keys) return self.emit(name, parameter_values) From cabb76348bfe182c0d8e3280998c55c0f27c15fc Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 6 Jun 2024 12:34:22 -0400 Subject: [PATCH 42/61] Update mapl_acg.cmake for new option --- cmake/mapl_acg.cmake | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/cmake/mapl_acg.cmake b/cmake/mapl_acg.cmake index fe125c68770b..0197f500a55b 100644 --- a/cmake/mapl_acg.cmake +++ b/cmake/mapl_acg.cmake @@ -12,6 +12,10 @@ # INTERNAL_SPECS [file] include file for AddInternalSpec() code (default _Internal___.h) # GET_POINTERS [file] include file for GetPointer() code (default _GetPointer___.h) # DECLARE_POINTERS [file] include file for declaring local pointers (default _DeclarePointer___.h) +# LONG_NAME_PREFIX [string] prefix for long names (default "comp_name") +# +# NOTE: Use of LONG_NAME_PREFIX will require changes to the Fortran code as all the ACG does +# is write Fortran. So, you'll need to define a string in the Fortran for this # ################################################################################################ @@ -22,7 +26,7 @@ function (mapl_acg target specs_file) # This list must align with oneValueArgs above (for later ZIP_LISTS) set (flags -i -x -p -g -d) set (defaults Import Export Internal GetPointer DeclarePointer) - set (multiValueArgs) + set (multiValueArgs LONG_NAME_PREFIX) cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) string (REPLACE "_GridComp" "" component_name ${target}) @@ -35,6 +39,12 @@ function (mapl_acg target specs_file) set (options "") set (suffix_for_generated_include_files "___.h") + # Note: Use the equals sign below. If a space is used, CMake did + # weird things + if (ARGS_LONG_NAME_PREFIX) + list (APPEND options "--longname_glob_prefix=${ARGS_LONG_NAME_PREFIX}") + endif () + # Handle oneValueArgs with no value (Python provides default) foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) From c607e1bac38c3278335228451d6edd66612aee92 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 11 Jun 2024 12:04:33 -0400 Subject: [PATCH 43/61] Update CI for latest GEOSgcm --- .circleci/config.yml | 4 ++-- CHANGELOG.md | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index b391e76ccb70..0d31469607e6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -16,8 +16,8 @@ parameters: # Anchors to prevent forgetting to update a version os_version: &os_version ubuntu20 -baselibs_version: &baselibs_version v7.24.0 -bcs_version: &bcs_version v11.3.0 +baselibs_version: &baselibs_version v7.23.0 +bcs_version: &bcs_version v11.5.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: diff --git a/CHANGELOG.md b/CHANGELOG.md index e62584cdc79b..1d8bdd7f0e6a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,12 +10,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights -- If file path length exceeds ESMF_MAXSTR, add _FAIL in subroutine fglob +- If file path length exceeds ESMF_MAXSTR, add `_FAIL` in subroutine fglob - Add GNU UFS-like CI test ### Changed -- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (NX*NY=Ncore) +- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (`NX*NY=Ncore`) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - ESMA_cmake v3.45.1 From ce6dbd06b87d42fb571abb92363d7189fca9d4db Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 13 Jun 2024 07:17:14 -0600 Subject: [PATCH 44/61] add notes on redistribute LS_ds to LS_chunk --- gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 73d24a9efd29..8dc0f98eaf46 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -645,8 +645,10 @@ subroutine append_file(this,current_time,rc) ! p_ds_3d(lm, nx) p_ds_3d = reshape(p_dst_3d, shape(p_ds_3d), order=[2,1]) + ! ... call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) - + ! redistributed: slower check. + if (this%level_by_level) then ! p_chunk_3d (lm, nx) allocate (p_dst_t, source = reshape(p_chunk_3d, [size(p_chunk_3d,2),size(p_chunk_3d,1)], order=[2,1])) From 1ec7efa276b2bcb561888b0e56d755d0beb069c2 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 13 Jun 2024 10:22:27 -0600 Subject: [PATCH 45/61] Add a few timers --- gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 8dc0f98eaf46..b6165e9016fa 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -637,16 +637,24 @@ subroutine append_file(this,current_time,rc) ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) call ESMF_FieldGet(dst_field,localDE=0,farrayptr=p_dst_3d,_RC) + call MAPL_TimerOn(this%GENSTATE,"assign p_dst_3d=0") p_dst_3d = 0.0 - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + print*, 'shape(p_dst_3d)', shape(p_dst_3d) + call MAPL_TimerOff(this%GENSTATE,"assign p_dst_3d=0") + call MAPL_TimerOn(this%GENSTATE,"3d_regrid") + call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + call MAPL_TimerOff(this%GENSTATE,"3d_regrid") + call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) + print*, 'shape(p_ds_3d)', shape(p_ds_3d) ! p_ds_3d(lm, nx) p_ds_3d = reshape(p_dst_3d, shape(p_ds_3d), order=[2,1]) ! ... - call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) + !! call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) + call ESMF_FieldRedist(field_ds_3d, field_chunk_3d, this%RH, _RC) ! redistributed: slower check. if (this%level_by_level) then From c74f83ee4d155f829705b2469f782f6f24d53f69 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Thu, 13 Jun 2024 23:59:14 -0600 Subject: [PATCH 46/61] use more efficient FA + field for consecutive regridding CS -- LS_ds-- LS_chunk -- LS_root --- .../Sampler/MAPL_StationSamplerMod.F90 | 67 ++++++++++--------- 1 file changed, 36 insertions(+), 31 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index b6165e9016fa..a4702b0a39da 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -415,6 +415,7 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) call ESMF_FieldGet( chunk_field, localDE=0, farrayPtr=pt2, _RC ) pt1=0.0 pt2=0.0 +!! print*, 'shape(pt1 LS_ds)', shape(pt1) call ESMF_FieldRedistStore(src_field,chunk_field,this%RH,_RC) call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) call ESMF_FieldDestroy(chunk_field,noGarbage=.true.,_RC) @@ -486,8 +487,10 @@ subroutine append_file(this,current_time,rc) integer :: ub(1), lb(1) type(GriddedIOitemVectorIterator) :: iter type(GriddedIOitem), pointer :: item - type(ESMF_Field) :: src_field,dst_field - real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:) ! source + type(ESMF_Grid) :: grid + type(ESMF_Field) :: src_field ! ,dst_field + type(ESMF_Field) :: new_src_field,new_dst_field + real(kind=REAL32), pointer :: p_src_3d(:,:,:),p_src_2d(:,:), qin_3d(:,:,:) ! source real(kind=REAL32), pointer :: p_dst_3d(:,:) ! destination real(kind=REAL32), pointer :: p_ds_3d(:,:),p_ds_2d(:) ! distributed LS real(kind=REAL32), pointer :: p_chunk_3d(:,:),p_chunk_2d(:) ! chunk LS @@ -497,7 +500,7 @@ subroutine append_file(this,current_time,rc) real(kind=REAL32), allocatable :: p_dst_t(:,:) real(kind=REAL32), allocatable :: arr(:,:) - character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) + character(len=ESMF_MAXSTR), allocatable :: fieldNameList(:) character(len=ESMF_MAXSTR) :: xname real(kind=ESMF_KIND_R8), allocatable :: rtimes(:) @@ -511,11 +514,9 @@ subroutine append_file(this,current_time,rc) ! intermediate fields as placeholder type(ESMF_Field) :: field_ds_2d - type(ESMF_Field) :: field_ds_3d type(ESMF_Field) :: field_chunk_2d type(ESMF_Field) :: field_chunk_3d - integer :: sec integer, allocatable :: ix(:) ! counter for each obs(k)%nobs_epoch logical :: EX ! file @@ -588,16 +589,21 @@ subroutine append_file(this,current_time,rc) !__ Aux. field ! + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) - dst_field = ESMF_FieldCreate (this%LS_ds, name='dst_field', typekind=ESMF_TYPEKIND_R4, & - gridToFieldMap=[1],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) - field_ds_3d = ESMF_FieldCreate (this%LS_ds, name='field_3d_ds', typekind=ESMF_TYPEKIND_R4, & + new_src_field = ESMF_FieldCreate (grid, name='new_src_field', typekind=ESMF_TYPEKIND_R4, & + gridToFieldMap=[2,3],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + new_dst_field = ESMF_FieldCreate (this%LS_ds, name='new_dst_field', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) + call ESMF_FieldGet(new_src_field,localDE=0,farrayPtr=p_src_3d,_RC) + call ESMF_FieldGet(new_dst_field,localDE=0,farrayPtr=p_dst_3d,_RC) + call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) iter = this%items%begin() do while (iter /= this%items%end()) @@ -611,7 +617,6 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_2d,_RC) call ESMF_FieldGet(field_ds_2d,localDE=0,farrayptr=p_ds_2d,_RC) call ESMF_FieldGet(field_chunk_2d,localDE=0,farrayPtr=p_chunk_2d,_RC) - p_ds_2d = 0.0 call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) @@ -635,28 +640,27 @@ subroutine append_file(this,current_time,rc) case(3) ! -- CS-> LS_ds; ds->chunk; gather ! - call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_3d,_RC) - call ESMF_FieldGet(dst_field,localDE=0,farrayptr=p_dst_3d,_RC) - call MAPL_TimerOn(this%GENSTATE,"assign p_dst_3d=0") - p_dst_3d = 0.0 - print*, 'shape(p_dst_3d)', shape(p_dst_3d) - call MAPL_TimerOff(this%GENSTATE,"assign p_dst_3d=0") - - call MAPL_TimerOn(this%GENSTATE,"3d_regrid") - call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + call ESMF_FieldGet(src_field,localDE=0,farrayptr=qin_3d,_RC) + p_src_3d = reshape(qin_3d,shape(p_src_3d), order = [2,3,1]) + +! print*, 'shape(p_src_3d)', shape(p_src_3d) +! print*, 'shape(p_dst_3d)', shape(p_dst_3d) + + call MAPL_TimerOn(this%GENSTATE,"3d_regrid") +!! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) + call ESMF_FieldRegrid (new_src_field, new_dst_field, this%regridder%route_handle, _RC) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") - - call ESMF_FieldGet(field_ds_3d,localDE=0,farrayPtr=p_ds_3d,_RC) - call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) - print*, 'shape(p_ds_3d)', shape(p_ds_3d) - - ! p_ds_3d(lm, nx) - p_ds_3d = reshape(p_dst_3d, shape(p_ds_3d), order=[2,1]) - ! ... + + + call MAPL_TimerOn(this%GENSTATE,"ESMF_FieldRedist") + ! ... !! call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) - call ESMF_FieldRedist(field_ds_3d, field_chunk_3d, this%RH, _RC) - ! redistributed: slower check. - + call ESMF_FieldRedist(new_dst_field, field_chunk_3d, this%RH, _RC) + + call MAPL_TimerOff(this%GENSTATE,"ESMF_FieldRedist") + + + call MAPL_TimerOn(this%GENSTATE,"gahterv") if (this%level_by_level) then ! p_chunk_3d (lm, nx) allocate (p_dst_t, source = reshape(p_chunk_3d, [size(p_chunk_3d,2),size(p_chunk_3d,1)], order=[2,1])) @@ -672,6 +676,7 @@ subroutine append_file(this,current_time,rc) p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) end if + call MAPL_TimerOff(this%GENSTATE,"gahterv") ! if (mapl_am_i_root()) then ! do j=1, nx_sum, 500 @@ -700,9 +705,9 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldDestroy(field_ds_2d, noGarbage=.true., _RC) call ESMF_FieldDestroy(field_chunk_2d, noGarbage=.true., _RC) - call ESMF_FieldDestroy(field_ds_3d, noGarbage=.true., _RC) call ESMF_FieldDestroy(field_chunk_3d, noGarbage=.true., _RC) - call ESMF_FieldDestroy(dst_field, noGarbage=.true., _RC) + call ESMF_FieldDestroy(new_dst_field, noGarbage=.true., _RC) + call ESMF_FieldDestroy(new_src_field, noGarbage=.true., _RC) _RETURN(_SUCCESS) end subroutine append_file From 66f3b5834312c7e8d73ca7eca3bff45a983690c3 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 14 Jun 2024 10:37:55 -0600 Subject: [PATCH 47/61] Add more timing --- .../Sampler/MAPL_StationSamplerMod.F90 | 76 +++++++++---------- 1 file changed, 36 insertions(+), 40 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index a4702b0a39da..a9e0dbee574d 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -566,7 +566,6 @@ subroutine append_file(this,current_time,rc) displs(i) = displs(i-1) + recvcount(i-1) end do - nsend_v = nsend * lm ! vertical allocate (recvcount_v, source = recvcount * lm ) allocate (displs_v, source = displs * lm ) @@ -589,47 +588,45 @@ subroutine append_file(this,current_time,rc) !__ Aux. field ! + call MAPL_TimerOn(this%GENSTATE,"FieldCreate") - field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) - field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) - - new_src_field = ESMF_FieldCreate (grid, name='new_src_field', typekind=ESMF_TYPEKIND_R4, & + field_ds_2d = ESMF_FieldCreate (this%LS_ds, name='field_2d_ds', typekind=ESMF_TYPEKIND_R4, _RC) + field_chunk_2d = ESMF_FieldCreate (this%LS_chunk, name='field_2d_chunk', typekind=ESMF_TYPEKIND_R4, _RC) + new_src_field = ESMF_FieldCreate (grid, name='new_src_field', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2,3],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - new_dst_field = ESMF_FieldCreate (this%LS_ds, name='new_dst_field', typekind=ESMF_TYPEKIND_R4, & + new_dst_field = ESMF_FieldCreate (this%LS_ds, name='new_dst_field', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) field_chunk_3d = ESMF_FieldCreate (this%LS_chunk, name='field_3d_chunk', typekind=ESMF_TYPEKIND_R4, & gridToFieldMap=[2],ungriddedLBound=[1],ungriddedUBound=[lm],_RC) - call ESMF_FieldGet(new_src_field,localDE=0,farrayPtr=p_src_3d,_RC) - call ESMF_FieldGet(new_dst_field,localDE=0,farrayPtr=p_dst_3d,_RC) - call ESMF_FieldGet(field_chunk_3d,localDE=0,farrayPtr=p_chunk_3d,_RC) + call ESMF_FieldGet(field_ds_2d, localDE=0, farrayptr=p_ds_2d, _RC) + call ESMF_FieldGet(field_chunk_2d,localDE=0, farrayPtr=p_chunk_2d, _RC) + call ESMF_FieldGet(new_src_field, localDE=0, farrayPtr=p_src_3d, _RC) + call ESMF_FieldGet(new_dst_field, localDE=0, farrayPtr=p_dst_3d, _RC) + call ESMF_FieldGet(field_chunk_3d,localDE=0, farrayPtr=p_chunk_3d, _RC) + + call MAPL_TimerOff(this%GENSTATE,"FieldCreate") + + + call MAPL_TimerOn(this%GENSTATE,"Full_regrid") iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() if (item%itemType == ItemTypeScalar) then -!! if (mapl_am_i_root()) write(6,*) 'item%xname=', trim(item%xname) + !! if (mapl_am_i_root()) write(6,*) 'item%xname=', trim(item%xname) call ESMF_FieldBundleGet(this%bundle,trim(item%xname),field=src_field,_RC) call ESMF_FieldGet(src_field,rank=rank,_RC) select case (rank) case(2) call ESMF_FieldGet(src_field,localDE=0,farrayptr=p_src_2d,_RC) - call ESMF_FieldGet(field_ds_2d,localDE=0,farrayptr=p_ds_2d,_RC) - call ESMF_FieldGet(field_chunk_2d,localDE=0,farrayPtr=p_chunk_2d,_RC) - - call this%regridder%regrid(p_src_2d,p_ds_2d,_RC) - call ESMF_FieldRedist(field_ds_2d, field_chunk_2d, this%RH, _RC ) + call ESMF_FieldRegrid (src_field, field_ds_2d, this%regridder%route_handle, _RC) + call ESMF_FieldRedist (field_ds_2d, field_chunk_2d, this%RH, _RC ) call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & p_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) -! if (mapl_am_i_root()) then -! do j=1, nx_sum, 500000 -! write(6,*) 'p_rt_2d', p_rt_2d(j) -! end do -! end if - call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(trim(item%xname),p_rt_2d,& @@ -641,24 +638,25 @@ subroutine append_file(this,current_time,rc) ! -- CS-> LS_ds; ds->chunk; gather ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=qin_3d,_RC) - p_src_3d = reshape(qin_3d,shape(p_src_3d), order = [2,3,1]) -! print*, 'shape(p_src_3d)', shape(p_src_3d) -! print*, 'shape(p_dst_3d)', shape(p_dst_3d) + !! -- did not improve performance + !!call MAPL_TimerOn(this%GENSTATE,"kloopreshape") + !!do k=1, lm + !! p_src_3d(k,:,:) = qin_3d(:,:,k) + !!end do + !!call MAPL_TimerOff(this%GENSTATE,"kloopreshape") + + call MAPL_TimerOn(this%GENSTATE,"reshape") + p_src_3d = reshape(qin_3d,shape(p_src_3d),order=[2,3,1]) + call MAPL_TimerOff(this%GENSTATE,"reshape") call MAPL_TimerOn(this%GENSTATE,"3d_regrid") -!! call this%regridder%regrid(p_src_3d,p_dst_3d,_RC) call ESMF_FieldRegrid (new_src_field, new_dst_field, this%regridder%route_handle, _RC) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") - - call MAPL_TimerOn(this%GENSTATE,"ESMF_FieldRedist") - ! ... - !! call ESMF_FieldRegrid(field_ds_3d, field_chunk_3d, this%RH, _RC) - call ESMF_FieldRedist(new_dst_field, field_chunk_3d, this%RH, _RC) - - call MAPL_TimerOff(this%GENSTATE,"ESMF_FieldRedist") - + call MAPL_TimerOn(this%GENSTATE,"FieldRedist") + call ESMF_FieldRedist (new_dst_field, field_chunk_3d, this%RH, _RC) + call MAPL_TimerOff(this%GENSTATE,"FieldRedist") call MAPL_TimerOn(this%GENSTATE,"gahterv") if (this%level_by_level) then @@ -678,13 +676,6 @@ subroutine append_file(this,current_time,rc) end if call MAPL_TimerOff(this%GENSTATE,"gahterv") -! if (mapl_am_i_root()) then -! do j=1, nx_sum, 500 -! write(6,*) 'p_rt_3d', p_rt_3d(:,j) -! end do -! end if -! if (mapl_am_i_root()) write(6,*) 'regrid + gatherV in 3D' - call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then nz=size(p_rt_3d,1); nx=size(p_rt_3d,2) @@ -703,11 +694,16 @@ subroutine append_file(this,current_time,rc) call iter%next() end do + call MAPL_TimerOff(this%GENSTATE,"Full_regrid") + + + call MAPL_TimerOn(this%GENSTATE,"FieldDestroy") call ESMF_FieldDestroy(field_ds_2d, noGarbage=.true., _RC) call ESMF_FieldDestroy(field_chunk_2d, noGarbage=.true., _RC) call ESMF_FieldDestroy(field_chunk_3d, noGarbage=.true., _RC) call ESMF_FieldDestroy(new_dst_field, noGarbage=.true., _RC) call ESMF_FieldDestroy(new_src_field, noGarbage=.true., _RC) + call MAPL_TimerOff(this%GENSTATE,"FieldDestroy") _RETURN(_SUCCESS) end subroutine append_file From b1c66eb9a17f048334f75791fe464400f5709222 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 14 Jun 2024 13:20:49 -0400 Subject: [PATCH 48/61] Remove slow tests from ExtData tests --- CHANGELOG.md | 3 + .../ExtData_Testing_Framework/CMakeLists.txt | 84 +++++++++++-------- components.yaml | 2 +- 3 files changed, 54 insertions(+), 35 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d8bdd7f0e6a..eb2e16b7f959 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - ESMA_cmake v3.45.1 - Fix bug in meson detection - Updated `checkpoint_simulator` to not create and close file if not writing +- Update ExtData2G tests + - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIALS` + label run in CI ### Fixed diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index db2f9f97937c..be870586b949 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -2,37 +2,51 @@ string(REPLACE " " ";" MPI_Fortran_LIBRARY_VERSION_LIST ${MPI_Fortran_LIBRARY_VERSION_STRING}) list(GET MPI_Fortran_LIBRARY_VERSION_LIST 0 MPI_Fortran_LIBRARY_VERSION_FIRSTWORD) if(MPI_Fortran_LIBRARY_VERSION_FIRSTWORD MATCHES "Open") - list(APPEND MPIEXEC_PREFLAGS "-oversubscribe") + list(APPEND MPIEXEC_PREFLAGS "-oversubscribe") endif() file(STRINGS "test_cases/extdata_1g_cases.txt" TEST_CASES_1G) set(cutoff "7") +# We want to make a list of tests that are slow and can +# be skipped for ESSENTIAL testing. Most ExtData tests +# take 1-2 seconds at most, but some take 20-30 seconds. +set(SLOW_TESTS + "case6" + "case14" + "case15" + "case16" + "case20" + "case22" + "case23" +) + foreach(TEST_CASE ${TEST_CASES_1G}) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) - file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) + file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) else() - set(num_procs "1") + set(num_procs "1") endif() add_test( - NAME "ExtData1G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} - -DIS_EXTDATA2G=NO - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake - ) - if (${num_procs} LESS ${cutoff}) - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") + NAME "ExtData1G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=NO + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake + ) + if (${num_procs} GREATER ${cutoff}) + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_BIG_TESTS") + elseif (${TEST_CASE} IN_LIST SLOW_TESTS) + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SLOW_TESTS") else() - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_BIG_TESTS") + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") endif() - endforeach() file(STRINGS "test_cases/extdata_2g_cases.txt" TEST_CASES_2G) @@ -40,25 +54,27 @@ file(STRINGS "test_cases/extdata_2g_cases.txt" TEST_CASES_2G) foreach(TEST_CASE ${TEST_CASES_2G}) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) - file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) + file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) else() - set(num_procs "1") + set(num_procs "1") endif() add_test( - NAME "ExtData2G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} - -DIS_EXTDATA2G=YES - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake - ) - if (${num_procs} LESS ${cutoff}) - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") + NAME "ExtData2G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=YES + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake + ) + if (${num_procs} GREATER ${cutoff}) + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_BIG_TESTS") + elseif (${TEST_CASE} IN_LIST SLOW_TESTS) + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SLOW_TESTS") else() - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_BIG_TESTS") + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") endif() endforeach() diff --git a/components.yaml b/components.yaml index 8db5c310f58b..b6a9bb01aa21 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.45.1 + tag: v3.45.3 develop: develop ecbuild: From 33d311357c3bde2074439ee31aee792e4876a629 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 14 Jun 2024 13:21:44 -0400 Subject: [PATCH 49/61] Update changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index eb2e16b7f959..bfd6851bc71b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,7 +22,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fix bug in meson detection - Updated `checkpoint_simulator` to not create and close file if not writing - Update ExtData2G tests - - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIALS` + - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIAL` label run in CI ### Fixed From 398f9177fb42cf8dc31c49709a747ab3e0036d32 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 14 Jun 2024 13:28:13 -0400 Subject: [PATCH 50/61] Remove ExtData1G from essential tests --- CHANGELOG.md | 3 ++- Tests/ExtData_Testing_Framework/CMakeLists.txt | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bfd6851bc71b..e9539c2b95b0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,9 +21,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - ESMA_cmake v3.45.1 - Fix bug in meson detection - Updated `checkpoint_simulator` to not create and close file if not writing -- Update ExtData2G tests +- Update ExtData tests - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIAL` label run in CI + - Remove ExtData1G tests from `ESSENTIAL` label ### Fixed diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index be870586b949..507ff970b7fe 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -45,7 +45,6 @@ foreach(TEST_CASE ${TEST_CASES_1G}) set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SLOW_TESTS") else() set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") endif() endforeach() From d8792d7f1ce730865ccd57099d47991746605108 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 14 Jun 2024 13:31:34 -0400 Subject: [PATCH 51/61] Have UFS-like CI run ExtData1G --- .circleci/config.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 0d31469607e6..bae974ba32af 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -57,7 +57,8 @@ workflows: remove_pflogger: true extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_WITH_FARGPARSE=OFF -DUSE_EXTDATA2G=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true - ctest_options: "-L 'ESSENTIAL' --output-on-failure" + # ExtData1G tests were removed from ESSENTIAL, so we run them separately here as UFS might still use 1G? + ctest_options: "-L 'ESSENTIAL|EXTDATA1G_SMALL_TESTS' --output-on-failure" # Run MAPL Tutorials - ci/run_mapl_tutorial: From faf096f47af880d27e13332c6649a670ad3c847e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 14 Jun 2024 13:33:31 -0400 Subject: [PATCH 52/61] Update changelog --- CHANGELOG.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e9539c2b95b0..cb61471ebebb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,8 +18,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (`NX*NY=Ncore`) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - - ESMA_cmake v3.45.1 - - Fix bug in meson detection + - ESMA_cmake v3.45.3 + - Fix bugs in meson detection + - Fix for building on older macOS - Updated `checkpoint_simulator` to not create and close file if not writing - Update ExtData tests - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIAL` From 99435930365430dcd0ed9dc0577c1bd7cef78755 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 18 Jun 2024 07:17:28 -0600 Subject: [PATCH 53/61] add MPI_Barrier --- .../Sampler/MAPL_StationSamplerMod.F90 | 21 +++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index a9e0dbee574d..7b5928eb8be4 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -609,7 +609,7 @@ subroutine append_file(this,current_time,rc) call MAPL_TimerOff(this%GENSTATE,"FieldCreate") - call MAPL_TimerOn(this%GENSTATE,"Full_regrid") +!! call MAPL_TimerOn(this%GENSTATE,"Full_regrid") iter = this%items%begin() do while (iter /= this%items%end()) @@ -654,11 +654,20 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldRegrid (new_src_field, new_dst_field, this%regridder%route_handle, _RC) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") + + + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) call MAPL_TimerOn(this%GENSTATE,"FieldRedist") call ESMF_FieldRedist (new_dst_field, field_chunk_3d, this%RH, _RC) + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) call MAPL_TimerOff(this%GENSTATE,"FieldRedist") - call MAPL_TimerOn(this%GENSTATE,"gahterv") + + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call MAPL_TimerOn(this%GENSTATE,"gatherv") if (this%level_by_level) then ! p_chunk_3d (lm, nx) allocate (p_dst_t, source = reshape(p_chunk_3d, [size(p_chunk_3d,2),size(p_chunk_3d,1)], order=[2,1])) @@ -666,6 +675,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & p_rt_3d_aux(1,k), recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY (ierr) end do deallocate(p_dst_t) p_rt_3d = reshape(p_rt_3d_aux, shape(p_rt_3d), order=[2,1]) @@ -674,7 +684,10 @@ subroutine append_file(this,current_time,rc) p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) end if - call MAPL_TimerOff(this%GENSTATE,"gahterv") + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call MAPL_TimerOff(this%GENSTATE,"gatherv") + call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then @@ -694,7 +707,7 @@ subroutine append_file(this,current_time,rc) call iter%next() end do - call MAPL_TimerOff(this%GENSTATE,"Full_regrid") +!! call MAPL_TimerOff(this%GENSTATE,"Full_regrid") call MAPL_TimerOn(this%GENSTATE,"FieldDestroy") From d00bd437302ed70aa4ef1a3c3673da9d0b6599bc Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 18 Jun 2024 12:45:31 -0400 Subject: [PATCH 54/61] Prepare for 2.47.0 Release --- CHANGELOG.md | 25 +++++++++++++++++-------- CMakeLists.txt | 2 +- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b369229e267..3ea632a2b9bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,14 +9,25 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights -- If file path length exceeds ESMF_MAXSTR, add `_FAIL` in subroutine fglob +### Changed + +### Fixed + +### Removed + +### Deprecated + +## [2.47.0] - 2024-06-20 + +### Added + +- Add new option to `Regrid_Util.x` to write and re-use ESMF pregenerated weights +- If file path length exceeds `ESMF_MAXSTR`, add `_FAIL` in subroutine fglob - Add GNU UFS-like CI test -- Add capability to mangle `LONG_NAME in ACG with a different prefix +- Add capability to mangle `LONG_NAME` in ACG with a different prefix ### Changed -- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (`NX*NY=Ncore`) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - ESMA_cmake v3.45.3 @@ -26,16 +37,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Update ExtData tests - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIAL` label run in CI - - Remove ExtData1G tests from `ESSENTIAL` label + - Remove ExtData1G tests from `ESSENTIAL` label, but run them in the UFS-like CI test ### Fixed +- Fixed a bug in `generate_newnxy` in `MAPL_SwathGridFactory.F90` (`NX*NY=Ncore`) - Fixes for NVHPC 24.5 - Convert `MAPL_GeosatMaskMod` to "interface-in-both-files" submodule style -### Removed - -### Deprecated ## [2.46.2] - 2024-05-31 diff --git a/CMakeLists.txt b/CMakeLists.txt index b2bd7cd2619a..5fdc64dc96b7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.46.2 + VERSION 2.47.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 2b335c5682c143c47199f4f93237aed0dcb98b61 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 19 Jun 2024 21:52:39 -0400 Subject: [PATCH 55/61] change default for 3d gather to true --- gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 3 ++- gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index c5f59b10ceec..f19e204d9c04 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -5,13 +5,14 @@ implicit none contains -module function MaskSamplerGeosat_from_config(config,string,clock,rc) result(mask) +module function MaskSamplerGeosat_from_config(config,string,clock,GENSTATE,rc) result(mask) use BinIOMod use pflogger, only : Logger, logging type(MaskSamplerGeosat) :: mask type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: string type(ESMF_Clock), intent(in) :: clock + type(MAPL_MetaComp), pointer, intent(in), optional :: GENSTATE integer, optional, intent(out) :: rc type(ESMF_Time) :: currTime diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 7b5928eb8be4..fb88060e4dda 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -308,7 +308,7 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, GENSTATE, rc ! init ofile sampler%ofile='' sampler%obs_written=0 - sampler%level_by_level = .true. + sampler%level_by_level = .false. ! .true. _RETURN(_SUCCESS) end function new_StationSampler_readfile From 1882b75ff8caa3e01be0abb92c6f8b96eb4e7f21 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 21 Jun 2024 08:24:36 -0400 Subject: [PATCH 56/61] Update to ESMA_cmake v3.46.0 --- CHANGELOG.md | 13 +++++++------ components.yaml | 2 +- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b369229e267..87111de378b8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,27 +9,28 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add new option to Regrid_Util.x to write and re-use ESMF pregenerated weights -- If file path length exceeds ESMF_MAXSTR, add `_FAIL` in subroutine fglob +- Add new option to `Regrid_Util.x` to write and re-use ESMF pregenerated weights +- If file path length exceeds `ESMF_MAXSTR`, add `_FAIL` in subroutine fglob - Add GNU UFS-like CI test -- Add capability to mangle `LONG_NAME in ACG with a different prefix +- Add capability to mangle `LONG_NAME` in ACG with a different prefix ### Changed -- fixed a bug in generate_newnxy in MAPL_SwathGridFactory.F90 (`NX*NY=Ncore`) - pFIO Clients don't send "Done" message when there is no request - Update `components.yaml` - - ESMA_cmake v3.45.3 + - ESMA_cmake v3.46.0 - Fix bugs in meson detection - Fix for building on older macOS + - Add `esma_add_fortran_submodules` function - Updated `checkpoint_simulator` to not create and close file if not writing - Update ExtData tests - Add new category of `SLOW` tests that take 10-30 seconds and remove them from the `ESSENTIAL` label run in CI - - Remove ExtData1G tests from `ESSENTIAL` label + - Remove ExtData1G tests from `ESSENTIAL` label, but run them in the UFS-like CI test ### Fixed +- Fixed a bug in `generate_newnxy` in `MAPL_SwathGridFactory.F90` (`NX*NY=Ncore`) - Fixes for NVHPC 24.5 - Convert `MAPL_GeosatMaskMod` to "interface-in-both-files" submodule style diff --git a/components.yaml b/components.yaml index b6a9bb01aa21..bf46f2c95c5d 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.45.3 + tag: v3.46.0 develop: develop ecbuild: From 31e69bb8f23924c30742869c84c0d4a1aae5f4fe Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 21 Jun 2024 15:41:44 -0600 Subject: [PATCH 57/61] code clean up --- .../Sampler/MAPL_StationSamplerMod.F90 | 32 +++---------------- .../History/Sampler/MAPL_TrajectoryMod.F90 | 2 +- 2 files changed, 5 insertions(+), 29 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index fb88060e4dda..8a94d5ef5665 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -304,11 +304,10 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, GENSTATE, rc call ESMF_FieldBundleGet(bundle,grid=grid,_RC) sampler%LS_ds = sampler%LSF%create_locstream_on_proc(grid=grid,_RC) - ! ! init ofile sampler%ofile='' sampler%obs_written=0 - sampler%level_by_level = .false. ! .true. + sampler%level_by_level = .false. _RETURN(_SUCCESS) end function new_StationSampler_readfile @@ -391,7 +390,6 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() - !!print*, 'list item%xname', trim(item%xname) if (item%itemType == ItemTypeScalar) then call this%create_variable(item%xname,_RC) else if (item%itemType == ItemTypeVector) then @@ -415,7 +413,6 @@ subroutine add_metadata_route_handle (this,items,bundle,timeInfo,vdata,rc) call ESMF_FieldGet( chunk_field, localDE=0, farrayPtr=pt2, _RC ) pt1=0.0 pt2=0.0 -!! print*, 'shape(pt1 LS_ds)', shape(pt1) call ESMF_FieldRedistStore(src_field,chunk_field,this%RH,_RC) call ESMF_FieldDestroy(src_field,noGarbage=.true.,_RC) call ESMF_FieldDestroy(chunk_field,noGarbage=.true.,_RC) @@ -462,7 +459,6 @@ subroutine create_metadata_variable(this,vname,rc) case default _FAIL('unsupported rank') end select - ! v = variable(type=PFIO_REAL32,dimensions=trim(vdims),chunksizes=chunksizes) v = variable(type=PFIO_REAL32,dimensions=trim(vdims)) call v%add_attribute('units',trim(units)) @@ -526,12 +522,10 @@ subroutine append_file(this,current_time,rc) integer :: is, ie, ierr integer :: M, N, ip - this%obs_written=this%obs_written+1 !__ 1. put_var: time variable ! - ! rtimes = this%compute_time_for_current(current_time,_RC) ! rtimes: seconds since opening file if (mapl_am_i_root()) then call this%formatter%put_var('time',rtimes(1:1),& @@ -542,8 +536,9 @@ subroutine append_file(this,current_time,rc) !__ 2. regrid + put_var: ! ungridded_dim from src to dst [regrid] ! - ! caution about zero-sized array for MPI - ! redist + ! caution about zero-sized array for MPI + ! redist + ! nx_sum = this%nstation lm = this%vdata%lm call ESMF_VMGetCurrent(vm,_RC) @@ -608,9 +603,6 @@ subroutine append_file(this,current_time,rc) call MAPL_TimerOff(this%GENSTATE,"FieldCreate") - -!! call MAPL_TimerOn(this%GENSTATE,"Full_regrid") - iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() @@ -639,13 +631,6 @@ subroutine append_file(this,current_time,rc) ! call ESMF_FieldGet(src_field,localDE=0,farrayptr=qin_3d,_RC) - !! -- did not improve performance - !!call MAPL_TimerOn(this%GENSTATE,"kloopreshape") - !!do k=1, lm - !! p_src_3d(k,:,:) = qin_3d(:,:,k) - !!end do - !!call MAPL_TimerOff(this%GENSTATE,"kloopreshape") - call MAPL_TimerOn(this%GENSTATE,"reshape") p_src_3d = reshape(qin_3d,shape(p_src_3d),order=[2,3,1]) call MAPL_TimerOff(this%GENSTATE,"reshape") @@ -654,8 +639,6 @@ subroutine append_file(this,current_time,rc) call ESMF_FieldRegrid (new_src_field, new_dst_field, this%regridder%route_handle, _RC) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") - - call MPI_Barrier(mpic,ierr) _VERIFY (ierr) call MAPL_TimerOn(this%GENSTATE,"FieldRedist") @@ -665,8 +648,6 @@ subroutine append_file(this,current_time,rc) call MAPL_TimerOff(this%GENSTATE,"FieldRedist") - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) call MAPL_TimerOn(this%GENSTATE,"gatherv") if (this%level_by_level) then ! p_chunk_3d (lm, nx) @@ -684,8 +665,6 @@ subroutine append_file(this,current_time,rc) p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) end if - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) call MAPL_TimerOff(this%GENSTATE,"gatherv") @@ -707,8 +686,6 @@ subroutine append_file(this,current_time,rc) call iter%next() end do -!! call MAPL_TimerOff(this%GENSTATE,"Full_regrid") - call MAPL_TimerOn(this%GENSTATE,"FieldDestroy") call ESMF_FieldDestroy(field_ds_2d, noGarbage=.true., _RC) @@ -935,7 +912,6 @@ subroutine CSV_read_line_with_CH_I_R(line, name, lon, lat, rc) endif _ASSERT (ios==0, 'read error') - k=index(line(j+1:), '.') if (k > 0) then read(line(j+1:), *, iostat=ios) lat diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 index d42d0bcbdf0a..49c2eff96b38 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 @@ -73,7 +73,7 @@ module HistoryTrajectoryMod integer :: obsfile_Ts_index ! for epoch integer :: obsfile_Te_index logical :: active ! case: when no obs. exist - logical :: level_by_level = .true. + 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) From 6201ced9727705818c937fa436c5ee7a4583b5d9 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 17 Jul 2024 11:50:49 -0400 Subject: [PATCH 58/61] fixes #2913 --- CHANGELOG.md | 2 ++ field_utils/FieldUtilities.F90 | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 21512b2194c4..21333b8d2371 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed bug in FieldSet routines when passing R8 ESMF fields + ### Removed ### Deprecated diff --git a/field_utils/FieldUtilities.F90 b/field_utils/FieldUtilities.F90 index 130d09222f8e..e4f8e2930049 100644 --- a/field_utils/FieldUtilities.F90 +++ b/field_utils/FieldUtilities.F90 @@ -64,7 +64,7 @@ subroutine FieldSet_r8(field,constant_val,rc) if (type_kind == ESMF_TYPEKIND_R4) then call assign_fptr(field,f_ptr_r4,_RC) f_ptr_r4 = constant_val - else if (type_kind == ESMF_TYPEKIND_R4) then + else if (type_kind == ESMF_TYPEKIND_R8) then call assign_fptr(field,f_ptr_r8,_RC) f_ptr_r8 = constant_val else @@ -87,7 +87,7 @@ subroutine FieldSet_r4(field,constant_val,rc) if (type_kind == ESMF_TYPEKIND_R4) then call assign_fptr(field,f_ptr_r4,_RC) f_ptr_r4 = constant_val - else if (type_kind == ESMF_TYPEKIND_R4) then + else if (type_kind == ESMF_TYPEKIND_R8) then call assign_fptr(field,f_ptr_r8,_RC) f_ptr_r8 = constant_val else From 703b94314b839c009a712b4b223a1903b689c87d Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 17 Jul 2024 12:11:36 -0400 Subject: [PATCH 59/61] Update changelog and cmakelists for 2.47.1 release --- CHANGELOG.md | 8 ++++++-- CMakeLists.txt | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 21333b8d2371..dac6501fe597 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,12 +13,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed -- Fixed bug in FieldSet routines when passing R8 ESMF fields - ### Removed ### Deprecated +## [2.47.1] - 2024-07-17 + +### Fixed + +- Fixed bug in FieldSet routines when passing R8 ESMF fields + ## [2.47.0] - 2024-06-24 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 5fdc64dc96b7..34a9c4d35e30 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.47.0 + VERSION 2.47.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 92d5d58fd870c2f9cfbb90095eccde2cefc873d8 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 30 Jul 2024 09:32:08 -0400 Subject: [PATCH 60/61] Add Refactor to PR Template --- .github/PULL_REQUEST_TEMPLATE.md | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 0e3987557aa7..226b68f73357 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -3,6 +3,7 @@ - [ ] New feature (non-breaking change which adds functionality) - [ ] Breaking change (fix or feature that would cause existing functionality to change) - [ ] Trivial change (affects only documentation or cleanup) +- [ ] Refactor (no functional changes, no api changes) ## Checklist - [ ] Tested this change with a run of GEOSgcm From f11add481b0331f07a2581e588b04c1dad19e68c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 30 Jul 2024 09:54:46 -0400 Subject: [PATCH 61/61] Fix up CI --- .circleci/config.yml | 6 +++--- .github/workflows/workflow.yml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index bae974ba32af..0a1c854571f0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -16,7 +16,7 @@ parameters: # Anchors to prevent forgetting to update a version os_version: &os_version ubuntu20 -baselibs_version: &baselibs_version v7.23.0 +baselibs_version: &baselibs_version v7.25.0 bcs_version: &bcs_version v11.5.0 tag_build_arg_name: &tag_build_arg_name maplversion @@ -179,9 +179,9 @@ workflows: baselibs_version: *baselibs_version container_name: mapl mpi_name: intelmpi - mpi_version: 2021.6.0 + mpi_version: "2021.13" compiler_name: intel - compiler_version: 2022.1.0 + compiler_version: "2024.2" image_name: geos-env tag_build_arg_name: *tag_build_arg_name - ci/publish_docker: diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index f4b1e5f07cbc..76ed2d251565 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -35,7 +35,7 @@ jobs: name: Build and Test MAPL GNU runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env-mkl:v7.24.0-openmpi_5.0.2-gcc_13.2.0 + image: gmao/ubuntu20-geos-env-mkl:v7.25.0-openmpi_5.0.2-gcc_13.2.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests @@ -86,7 +86,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v7.24.0-intelmpi_2021.6.0-intel_2022.1.0 + image: gmao/ubuntu20-geos-env:v7.25.0-intelmpi_2021.13-intel_2024.2 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests