From 29f34fda3626348865d7d0576a25dcc117d6a06f Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 1 May 2024 15:46:22 -0600 Subject: [PATCH 01/14] 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 220c2bfbeba7dfbfeb77bf3287827ad940a1c267 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 8 May 2024 10:28:30 -0400 Subject: [PATCH 02/14] 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 03/14] 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 04/14] 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 609687a13c543be903fec0bd520d92925a63afbb Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 9 May 2024 13:00:59 -0400 Subject: [PATCH 05/14] Fix version --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 37c4aacd404c..4e86bd4d9df8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.45.0 + VERSION 2.46.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 6cb3b09316def32994ef0f934255ce17b575bd46 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 10 May 2024 09:08:25 -0400 Subject: [PATCH 06/14] Update to ESMA_cmake v3.45.1 on main --- CHANGELOG.md | 8 ++++++++ CMakeLists.txt | 2 +- components.yaml | 2 +- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bb095ae09e1a..7a355c1f4648 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,14 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.46.1] - 2024-05-10 + +## Fixed + +- Update `components.yaml` to avoid f2py error with python 3.11 + - ESMA_cmake v3.45.1 + - Fix bug in meson detection + ## [2.46.0] - 2024-05-02 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 4e86bd4d9df8..b1c83ba0ba64 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.46.0 + VERSION 2.46.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui 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 fb53e28c29f66a1530dbe4bce59b2d515d768b12 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 10 May 2024 09:36:42 -0400 Subject: [PATCH 07/14] 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/14] 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/14] 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 4416719c6452cbe931605fd6a2b2bab52c0dd804 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 15 May 2024 09:15:21 -0600 Subject: [PATCH 10/14] 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 11/14] 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 12/14] 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 b7e0b0fa8fcd26479e263fd3bebcb6c724c2cd20 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 17 May 2024 09:48:42 -0600 Subject: [PATCH 13/14] 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 14/14] 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