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 2ce678f6beda..8abd34c6285a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,12 +9,15 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add GNU UFS-like CI test + ### Changed - 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 +- Updated `checkpoint_simulator` to not create and close file if not writing ### Fixed @@ -22,12 +25,20 @@ 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 - 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 diff --git a/CMakeLists.txt b/CMakeLists.txt index 37c4aacd404c..b1c83ba0ba64 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.45.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/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..f2d257c21020 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 @@ -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 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..6b8610352a52 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2422,7 +2422,7 @@ 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) 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 @@ -3451,11 +3451,14 @@ 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") 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") 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 +3476,13 @@ 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 + call MAPL_TimerOff(GENSTATE,"Swath") end if - call MAPL_TimerOff(GENSTATE,"SwathGen") + call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_grid_case @@ -3525,7 +3529,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 @@ -3645,6 +3649,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 @@ -3691,14 +3696,24 @@ subroutine Run ( gc, import, export, clock, rc ) end if IOTYPE end if + 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 + endif OUTTIME if( NewSeg(n) .and. list(n)%unit /= 0 .and. list(n)%duration /= 0 ) then @@ -3724,20 +3739,20 @@ 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,"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 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,"Swath") end if - call MAPL_TimerOff(GENSTATE,"Swath regen") call MAPL_TimerOff(GENSTATE,trim(list(n)%collection)) end do epoch_swath_regen_grid @@ -3754,16 +3769,24 @@ 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,"Trajectory") + call MAPL_TimerOn(GENSTATE,"RegridAccum") call list(n)%trajectory%regrid_accumulate(_RC) + call MAPL_TimerOff(GENSTATE,"RegridAccum") if( ESMF_AlarmIsRinging ( list(n)%trajectory%alarm ) ) then + 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,"AppendFile") if ( .not. ESMF_AlarmIsRinging(list(n)%end_alarm) ) then + call MAPL_TimerOn(GENSTATE,"RegenLS") call list(n)%trajectory%destroy_rh_regen_LS (_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 @@ -3772,7 +3795,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 diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod.F90 index 18f78e4e2d55..d42d0bcbdf0a 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,6 +28,7 @@ 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 @@ -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