From bbefee30ab4cdb2b694da13ede62635187950745 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 21 Jun 2024 19:25:37 -0600 Subject: [PATCH 01/77] begin improve_mask_xygrid --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 87111de378b8..6356abf7a2a5 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 +- Improve mask and xy-grid (geostationary) sampler - 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 From 8a6c11c156ae86732659080ae12b0bed9b6d2fdd Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 25 Jun 2024 09:46:58 -0600 Subject: [PATCH 02/77] Replace LS_root --> LS_ds with LS_root --> LS_chunk --> LS_ds Get coord. of LS_ds(bk=CS) does not work directly: call ESMF_LocStreamGetKey( LS_ds, "ESMF:Lon", farray=ptA) gives wrong results --- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 +- .../History/Sampler/MAPL_GeosatMaskMod.F90 | 1 + .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 158 +++++++++++++----- 3 files changed, 123 insertions(+), 44 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index c287dae7b07d..4b048912bd70 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2426,8 +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 + call MAPL_TimerOn(GENSTATE,"mask_init") 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) + call MAPL_TimerOff(GENSTATE,"mask_init") elseif (list(n)%sampler_spec == 'station') then 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) @@ -3706,11 +3708,9 @@ subroutine Run ( gc, import, export, clock, rc ) 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 MAPL_TimerOn(GENSTATE,"Mask_append") call list(n)%mask_sampler%append_file(current_time,_RC) - call MAPL_TimerOff(GENSTATE,"AppendFile") - call MAPL_TimerOff(GENSTATE,"Mask") + call MAPL_TimerOff(GENSTATE,"Mask_append") endif diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 index 21e9d1251379..3d9563e976e2 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod.F90 @@ -21,6 +21,7 @@ module MaskSamplerGeosatMod use pFIO_FileMetadataMod, only : FileMetadata use pFIO_NetCDF4_FileFormatterMod, only : NetCDF4_FileFormatter 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: REAL32 use, intrinsic :: iso_fortran_env, only: REAL64 use pflogger, only: Logger, logging diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index f19e204d9c04..6dbe1e207547 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -35,7 +35,7 @@ module function MaskSamplerGeosat_from_config(config,string,clock,GENSTATE,rc) r 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 @@ -159,13 +159,13 @@ module subroutine create_Geosat_grid_find_mask(this, rc) integer, optional, intent(out) :: rc type(Logger), pointer :: lgr - real(ESMF_KIND_R8), pointer :: ptAT(:) type(ESMF_routehandle) :: RH type(ESMF_Grid) :: grid - integer :: mypet, npes + integer :: mypet, petcount, mpic integer :: iroot, rootpet, ierr type (ESMF_LocStream) :: LS_rt type (ESMF_LocStream) :: LS_ds + type (ESMF_LocStream) :: LS_chunk type (LocStreamFactory):: locstream_factory type (ESMF_Field) :: fieldA type (ESMF_Field) :: fieldB @@ -182,13 +182,11 @@ module subroutine create_Geosat_grid_find_mask(this, rc) type(ESMF_DElayout) :: layout type(ESMF_VM) :: VM integer :: myid - integer :: ndes integer :: dimCount integer, allocatable :: II(:) integer, allocatable :: JJ(:) real(REAL64), allocatable :: obs_lons(:) real(REAL64), allocatable :: obs_lats(:) - integer :: mpic type (ESMF_Field) :: fieldI4 type(ESMF_routehandle) :: RH_halo @@ -227,7 +225,17 @@ module subroutine create_Geosat_grid_find_mask(this, rc) integer :: nsend integer, allocatable :: recvcounts_loc(:) integer, allocatable :: displs_loc(:) - integer :: status + + integer, allocatable :: sendcount(:), displs(:) + integer :: recvcount + integer :: M, N, ip + integer :: nx2 + + real(REAL64), allocatable :: lons_chunk(:) + real(REAL64), allocatable :: lats_chunk(:) + + integer :: status, imethod + lgr => logging%get_logger('HISTORY.sampler') @@ -238,6 +246,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! prepare recvcounts + displs for gatherv ! + call MAPL_TimerOn(this%GENSTATE,"1_genABIgrid") if (mapl_am_i_root()) then ! __s1. SAT file ! @@ -289,58 +298,123 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end do arr(1)=nx else + nx=0 allocate(lons(0),lats(0),_STAT) arr(1)=0 endif + call ESMF_VMGetCurrent(vm,_RC) - call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=npes, localpet=mypet, _RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & count=1, reduceflag=ESMF_REDUCE_SUM, _RC) this%nobs = nx if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx + call MAPL_TimerOff(this%GENSTATE,"1_genABIgrid") - if ( nx == 0 ) then - this%is_valid = .false. - _RETURN(ESMF_SUCCESS) - ! - ! no valid obs points are found - ! - end if ! __ s2. set distributed LS ! + call MAPL_TimerOn(this%GENSTATE,"2_ABIgrid_LS") + ! + !__ distrubute data chunk for the locstream points : mpi_scatterV + !__ create LS on parallel processors + ! caution about zero-sized array for MPI + + nx_sum = nx + 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( lons, sendcount, & + displs, MPI_REAL8, lons_chunk, & + recvcount, MPI_REAL8, 0, mpic, ierr) + + call MPI_Scatterv( lats, sendcount, & + displs, MPI_REAL8, lats_chunk, & + recvcount, MPI_REAL8, 0, mpic, ierr) + + + ! -- root locstream_factory = LocStreamFactory(lons,lats,_RC) LS_rt = locstream_factory%create_locstream(_RC) - call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) - LS_ds = locstream_factory%create_locstream(grid=grid,_RC) - fieldA = ESMF_FieldCreate (LS_rt, name='A', typekind=ESMF_TYPEKIND_R8, _RC) - fieldB = ESMF_FieldCreate (LS_ds, name='B', typekind=ESMF_TYPEKIND_R8, _RC) + ! -- proc + locstream_factory = LocStreamFactory(lons_chunk,lats_chunk,_RC) + LS_chunk = locstream_factory%create_locstream_on_proc(_RC) - call ESMF_FieldGet( fieldA, localDE=0, farrayPtr=ptA) - call ESMF_FieldGet( fieldB, localDE=0, farrayPtr=ptB) - if (mypet == 0) then - ptA(:) = lons(:) + ! -- distributed with background grid + call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) + LS_ds = locstream_factory%create_locstream_on_proc(grid=grid,_RC) + + + ! -- get coord. method-2 + imethod=2 + if (imethod == 1) then + fieldA = ESMF_FieldCreate (LS_chunk, name='A', typekind=ESMF_TYPEKIND_R8, _RC) + fieldB = ESMF_FieldCreate (LS_ds, name='B', typekind=ESMF_TYPEKIND_R8, _RC) + + call ESMF_FieldGet( fieldA, localDE=0, farrayPtr=ptA) + call ESMF_FieldGet( fieldB, localDE=0, farrayPtr=ptB) + ptA(:) = lons_chunk(:) + + call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) + + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) + lons_ds = ptB + ptA(:) = lats_chunk(:) + + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) + lats_ds = ptB + + write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) + + call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) + call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) + call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) + elseif (imethod == 2) then + call ESMF_LocStreamGetKey( LS_ds, "ESMF:Lon", farray=ptA) + lons_ds = ptA + call ESMF_LocStreamGetKey( LS_ds, "ESMF:Lat", farray=ptB) + lats_ds = ptB + write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) end if - call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) - call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) - lons_ds = ptB - if (mypet == 0) then - ptA(:) = lats(:) - end if - call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) - lats_ds = ptB - call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) - call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) - call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) + call MAPL_TimerOff(this%GENSTATE,"2_ABIgrid_LS") + ! __ s3. find n.n. CS pts for LS_ds (halo) ! + call MAPL_TimerOn(this%GENSTATE,"3_CS_halo") obs_lons = lons_ds * MAPL_DEGREES_TO_RADIANS_R8 obs_lats = lats_ds * MAPL_DEGREES_TO_RADIANS_R8 nx = size ( lons_ds ) @@ -407,6 +481,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end if end do end do + call MAPL_TimerOff(this%GENSTATE,"3_CS_halo") ! ---- @@ -415,6 +490,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! - mpi_gatherV ! + call MAPL_TimerOn(this%GENSTATE,"4_gathV") ! __ s4.1 find this%lons/lats on root for NC output ! @@ -442,11 +518,11 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! __ s4.2 find this%recvcounts / this%displs ! - allocate( this%recvcounts(npes), this%displs(npes), _STAT ) - allocate( recvcounts_loc(npes), displs_loc(npes), _STAT ) + allocate( this%recvcounts(petcount), this%displs(petcount), _STAT ) + allocate( recvcounts_loc(petcount), displs_loc(petcount), _STAT ) recvcounts_loc(:)=1 displs_loc(1)=0 - do i=2, npes + do i=2, petcount displs_loc(i) = displs_loc(i-1) + recvcounts_loc(i-1) end do call MPI_gatherv ( this%npt_mask, 1, MPI_INTEGER, & @@ -456,7 +532,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) this%recvcounts(:) = 0 end if this%displs(1)=0 - do i=2, npes + do i=2, petcount this%displs(i) = this%displs(i-1) + this%recvcounts(i-1) end do @@ -471,6 +547,8 @@ module subroutine create_Geosat_grid_find_mask(this, rc) this%lats, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) + call MAPL_TimerOff(this%GENSTATE,"4_gathV") + _RETURN(_SUCCESS) end subroutine create_Geosat_grid_find_mask @@ -589,7 +667,7 @@ module subroutine regrid_append_file(this,current_time,rc) integer :: i, j, k, rank integer :: nx, nz integer :: ix, iy, m - integer :: mypet, npes, nsend + integer :: mypet, petcount, nsend integer :: iroot, ierr integer :: mpic integer, allocatable :: recvcounts_3d(:) @@ -602,7 +680,7 @@ module subroutine regrid_append_file(this,current_time,rc) ! -- fixed for all fields call ESMF_VMGetCurrent(vm,_RC) - call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=npes, localpet=mypet, _RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) iroot=0 nx = this%npt_mask nz = this%vdata%lm @@ -615,7 +693,7 @@ module subroutine regrid_append_file(this,current_time,rc) allocate ( p_dst_2d_full (0), _STAT ) allocate ( p_dst_3d_full (0), _STAT ) end if - allocate( recvcounts_3d(npes), displs_3d(npes), _STAT ) + allocate( recvcounts_3d(petcount), displs_3d(petcount), _STAT ) recvcounts_3d(:) = nz * this%recvcounts(:) displs_3d(:) = nz * this%displs(:) From 62c8e3e9db5ea5ce97876311907ac5b700006253 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 25 Jun 2024 10:15:31 -0600 Subject: [PATCH 03/77] removed the ESMF_LocStreamGetKey, not working for LS_ds(CS-grid) --- .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 63 +++++++------------ 1 file changed, 24 insertions(+), 39 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 6dbe1e207547..0be0bb22afba 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -365,53 +365,38 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! -- proc locstream_factory = LocStreamFactory(lons_chunk,lats_chunk,_RC) LS_chunk = locstream_factory%create_locstream_on_proc(_RC) - + ! -- distributed with background grid call ESMF_FieldBundleGet(this%bundle,grid=grid,_RC) LS_ds = locstream_factory%create_locstream_on_proc(grid=grid,_RC) - - ! -- get coord. method-2 - imethod=2 - if (imethod == 1) then - fieldA = ESMF_FieldCreate (LS_chunk, name='A', typekind=ESMF_TYPEKIND_R8, _RC) - fieldB = ESMF_FieldCreate (LS_ds, name='B', typekind=ESMF_TYPEKIND_R8, _RC) - - call ESMF_FieldGet( fieldA, localDE=0, farrayPtr=ptA) - call ESMF_FieldGet( fieldB, localDE=0, farrayPtr=ptB) - ptA(:) = lons_chunk(:) - - call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) - - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) - call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) - lons_ds = ptB - ptA(:) = lats_chunk(:) - - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) - call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) - lats_ds = ptB - - write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) - - call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) - call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) - call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) - elseif (imethod == 2) then - call ESMF_LocStreamGetKey( LS_ds, "ESMF:Lon", farray=ptA) - lons_ds = ptA - call ESMF_LocStreamGetKey( LS_ds, "ESMF:Lat", farray=ptB) - lats_ds = ptB - write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) - end if - + fieldA = ESMF_FieldCreate (LS_chunk, name='A', typekind=ESMF_TYPEKIND_R8, _RC) + fieldB = ESMF_FieldCreate (LS_ds, name='B', typekind=ESMF_TYPEKIND_R8, _RC) + call ESMF_FieldGet( fieldA, localDE=0, farrayPtr=ptA) + call ESMF_FieldGet( fieldB, localDE=0, farrayPtr=ptB) + + ptA(:) = lons_chunk(:) + call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) + lons_ds = ptB + + ptA(:) = lats_chunk(:) + call MPI_Barrier(mpic,ierr) + _VERIFY (ierr) + call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) + lats_ds = ptB + + write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) + + call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) + call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) + call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) call MAPL_TimerOff(this%GENSTATE,"2_ABIgrid_LS") - ! __ s3. find n.n. CS pts for LS_ds (halo) ! call MAPL_TimerOn(this%GENSTATE,"3_CS_halo") From 4e4562d9bab9e3a82ebb733f475c8913e8c57f8a Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 25 Jun 2024 18:50:05 -0600 Subject: [PATCH 04/77] 1. Use MPI to process ABI_grid data to Lon/Lat, which is more efficient 2. add LS_chunk as middle step to get coordinates for LS_ds(CS-grid) --- .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 161 ++++++++++-------- 1 file changed, 87 insertions(+), 74 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 0be0bb22afba..88376983270b 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -240,12 +240,17 @@ module subroutine create_Geosat_grid_find_mask(this, rc) lgr => logging%get_logger('HISTORY.sampler') ! Metacode: - ! read ABI grid into LS_rt - ! gen LS_ds with CS background grid + ! read ABI grid into lons/lats, lons_chunk/lats_chunk + ! gen LS_chunk and LS_ds with CS background grid ! find mask points on each PET with halo ! prepare recvcounts + displs for gatherv ! - + + call ESMF_VMGetCurrent(vm,_RC) + call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) + ip = mypet ! 0 to M-1 + M = petCount + call MAPL_TimerOn(this%GENSTATE,"1_genABIgrid") if (mapl_am_i_root()) then ! __s1. SAT file @@ -256,107 +261,115 @@ module subroutine create_Geosat_grid_find_mask(this, rc) key_p = this%var_name_proj key_p_att = this%att_name_proj call get_ncfile_dimension(fn,nlon=n1,nlat=n2,key_lon=key_x,key_lat=key_y,_RC) - ! - ! use thin_factor to reduce regridding matrix size - ! - xdim_true = n1 - ydim_true = n2 - xdim_red = n1 / this%thin_factor - ydim_red = n2 / this%thin_factor - allocate (x (xdim_true), _STAT ) - allocate (y (xdim_true), _STAT ) - + allocate (x(n1), y(n2), _STAT) call get_v1d_netcdf_R8_complete (fn, key_x, x, _RC) call get_v1d_netcdf_R8_complete (fn, key_y, y, _RC) call get_att_real_netcdf (fn, key_p, key_p_att, lambda0_deg, _RC) lam_sat = lambda0_deg * MAPL_DEGREES_TO_RADIANS_R8 + end if + call MAPL_CommsBcast(vm, DATA=n1, N=1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=n2, N=1, ROOT=MAPL_Root, _RC) + if ( .NOT. mapl_am_i_root() ) allocate (x(n1), y(n2), _STAT) + call MAPL_CommsBcast(vm, DATA=lam_sat, N=1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=x, N=n1, ROOT=MAPL_Root, _RC) + call MAPL_CommsBcast(vm, DATA=y, N=n2, ROOT=MAPL_Root, _RC) - nx=0 - do i=1, xdim_red - do j=1, ydim_red + ! + ! use thin_factor to reduce regridding matrix size + ! + xdim_red = n1 / this%thin_factor + ydim_red = n2 / this%thin_factor + _ASSERT ( xdim_red * ydim_red > M, 'mask reduced points after thin_factor is less than Nproc!') + + ! get nx2 + nx2=0 + k=0 + do i=1, xdim_red + do j=1, ydim_red + k = k + 1 + if ( mod(k,M) == ip ) then x0 = x( i * this%thin_factor ) y0 = y( j * this%thin_factor ) call ABI_XY_2_lonlat (x0, y0, lam_sat, lon0, lat0, mask=mask0) if (mask0 > 0) then - nx=nx+1 + nx2=nx2+1 end if - end do + end if end do - allocate (lons(nx), lats(nx), _STAT) - nx = 0 - do i=1, xdim_red - do j=1, ydim_red + end do + allocate (lons_chunk(nx2), lats_chunk(nx2), _STAT) + + ! get lons_chunk/... + nx2 = 0 + k = 0 + do i=1, xdim_red + do j=1, ydim_red + k = k + 1 + if ( mod(k,M) == ip ) then x0 = x( i * this%thin_factor ) y0 = y( j * this%thin_factor ) call ABI_XY_2_lonlat (x0, y0, lam_sat, lon0, lat0, mask=mask0) if (mask0 > 0) then - nx=nx+1 - lons(nx) = lon0 * MAPL_RADIANS_TO_DEGREES - lats(nx) = lat0 * MAPL_RADIANS_TO_DEGREES + nx2=nx2+1 + lons_chunk(nx2) = lon0 * MAPL_RADIANS_TO_DEGREES + lats_chunk(nx2) = lat0 * MAPL_RADIANS_TO_DEGREES end if - end do + end if end do - arr(1)=nx + end do + arr(1)=nx2 + + + call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & + count=1, reduceflag=ESMF_REDUCE_SUM, _RC) + write(6,*) 'ip, nx, nx2', ip, nx, nx2 + + ! gatherV for lons/lats + if (mapl_am_i_root()) then + allocate(lons(nx),lats(nx),_STAT) else nx=0 allocate(lons(0),lats(0),_STAT) - arr(1)=0 endif + + allocate( this%recvcounts(petcount), this%displs(petcount), _STAT ) + allocate( recvcounts_loc(petcount), displs_loc(petcount), _STAT ) + recvcounts_loc(:)=1 + displs_loc(1)=0 + do i=2, petcount + displs_loc(i) = displs_loc(i-1) + recvcounts_loc(i-1) + end do + call MPI_gatherv ( nx2, 1, MPI_INTEGER, & + this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& + iroot, mpic, ierr ) + if (.not. mapl_am_i_root()) then + this%recvcounts(:) = 0 + end if + this%displs(1)=0 + do i=2, petcount + this%displs(i) = this%displs(i-1) + this%recvcounts(i-1) + end do + nsend = nx2 + call MPI_gatherv ( lons_chunk, nsend, MPI_REAL8, & + lons, this%recvcounts, this%displs, MPI_REAL8,& + iroot, mpic, ierr ) + call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & + lats, this%recvcounts, this%displs, MPI_REAL8,& + iroot, mpic, ierr ) - call ESMF_VMGetCurrent(vm,_RC) - call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) - call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & - count=1, reduceflag=ESMF_REDUCE_SUM, _RC) this%nobs = nx if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx - call MAPL_TimerOff(this%GENSTATE,"1_genABIgrid") - + deallocate (this%recvcounts, this%displs, _STAT) + deallocate (recvcounts_loc, displs_loc, _STAT) + deallocate (x, y, _STAT) + call MAPL_TimerOff(this%GENSTATE,"1_genABIgrid") + ! __ s2. set distributed LS ! call MAPL_TimerOn(this%GENSTATE,"2_ABIgrid_LS") - ! - !__ distrubute data chunk for the locstream points : mpi_scatterV - !__ create LS on parallel processors - ! caution about zero-sized array for MPI - - nx_sum = nx - 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( lons, sendcount, & - displs, MPI_REAL8, lons_chunk, & - recvcount, MPI_REAL8, 0, mpic, ierr) - - call MPI_Scatterv( lats, sendcount, & - displs, MPI_REAL8, lats_chunk, & - recvcount, MPI_REAL8, 0, mpic, ierr) - ! -- root locstream_factory = LocStreamFactory(lons,lats,_RC) From 74466ceed02066b30ded47af58e347f6954e1e0c Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 25 Jun 2024 18:55:53 -0600 Subject: [PATCH 05/77] clean up code --- gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 88376983270b..93b37449b74b 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -322,7 +322,6 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & count=1, reduceflag=ESMF_REDUCE_SUM, _RC) - write(6,*) 'ip, nx, nx2', ip, nx, nx2 ! gatherV for lons/lats if (mapl_am_i_root()) then @@ -357,9 +356,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & lats, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) - this%nobs = nx - if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx deallocate (this%recvcounts, this%displs, _STAT) deallocate (recvcounts_loc, displs_loc, _STAT) @@ -401,8 +398,6 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lats_ds = ptB - write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) - call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) From 11eec594d648092a578b837d4a5ac5c51a58d825 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Tue, 25 Jun 2024 19:49:40 -0600 Subject: [PATCH 06/77] add change log --- CHANGELOG.md | 2 +- .../History/Sampler/MAPL_GeosatMaskMod_smod.F90 | 12 ++++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6356abf7a2a5..a69454bf2926 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Improve mask and xy-grid (geostationary) sampler +- Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - 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/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 93b37449b74b..f6651394c3e9 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -248,6 +248,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, petcount=petcount, localpet=mypet, _RC) + iroot = 0 ip = mypet ! 0 to M-1 M = petCount @@ -317,17 +318,16 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end if end do end do - arr(1)=nx2 - + arr(1)=nx2 call ESMF_VMAllFullReduce(vm, sendData=arr, recvData=nx, & count=1, reduceflag=ESMF_REDUCE_SUM, _RC) + ! gatherV for lons/lats if (mapl_am_i_root()) then allocate(lons(nx),lats(nx),_STAT) else - nx=0 allocate(lons(0),lats(0),_STAT) endif @@ -356,7 +356,9 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & lats, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) - this%nobs = nx + + +!! if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx deallocate (this%recvcounts, this%displs, _STAT) deallocate (recvcounts_loc, displs_loc, _STAT) @@ -398,6 +400,8 @@ module subroutine create_Geosat_grid_find_mask(this, rc) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lats_ds = ptB +!! write(6,*) 'ip, size(lons_ds)=', mypet, size(lons_ds) + call ESMF_FieldDestroy(fieldA,nogarbage=.true.,_RC) call ESMF_FieldDestroy(fieldB,nogarbage=.true.,_RC) call ESMF_FieldRedistRelease(RH, noGarbage=.true., _RC) From 9138cc42c3940ba721a80c86f70156951155016f Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 26 Jun 2024 10:13:31 -0600 Subject: [PATCH 07/77] correct a typo --- 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 6118f7a1e152..3e9aa6d9a11f 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -487,7 +487,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ! - mpi_gatherV ! - call MAPL_TimerOn(this%GENSTATE,"4_gathV") + call MAPL_TimerOn(this%GENSTATE,"4_gatherV") ! __ s4.1 find this%lons/lats on root for NC output ! @@ -544,7 +544,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) this%lats, this%recvcounts, this%displs, MPI_REAL8,& iroot, mpic, ierr ) - call MAPL_TimerOff(this%GENSTATE,"4_gathV") + call MAPL_TimerOff(this%GENSTATE,"4_gatherV") _RETURN(_SUCCESS) end subroutine create_Geosat_grid_find_mask From 60dd3d25fc0bf18efce05bbb49d430f643bd3739 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Wed, 26 Jun 2024 10:14:29 -0600 Subject: [PATCH 08/77] update changelog --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f46bd14f1430..53af305d2821 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 +- Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) + ### Fixed ### Removed @@ -21,7 +23,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - 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 From 589b414f592f11b89c4aa56e89de1e0cccbb6a67 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 11 Jul 2024 12:08:39 -0400 Subject: [PATCH 09/77] Update CI Baselibs to 7.25.0 --- .circleci/config.yml | 2 +- .github/workflows/workflow.yml | 4 ++-- CHANGELOG.md | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index bae974ba32af..998ba2369fc4 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 diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index f4b1e5f07cbc..bd6f785f72e6 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.6.0-intel_2022.1.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 diff --git a/CHANGELOG.md b/CHANGELOG.md index 53af305d2821..ee3aed3d51c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) +- Update Baselibs in CI to 7.25.0 ### Fixed From 9bbcc859c76ee6da43943cccf45ae8a701938026 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 15 Jul 2024 12:54:43 -0400 Subject: [PATCH 10/77] Update to ESMA_cmake v3.48.0 --- CHANGELOG.md | 4 ++++ components.yaml | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 53af305d2821..73919beb3ba2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) +- Update `components.yaml` + - ESMA_cmake v3.48.0 + - Update `esma_add_fortran_submodules` function + - Move MPI detection out of FindBaselibs ### Fixed diff --git a/components.yaml b/components.yaml index bf46f2c95c5d..014f29f2b77f 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.46.0 + tag: v3.48.0 develop: develop ecbuild: From 6ccd0eebf6b83d12e2fcd68bb9016532def9c5d3 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Wed, 17 Jul 2024 22:11:39 -0400 Subject: [PATCH 11/77] Add VERIFY statements in the base folder --- base/ApplicationSupport.F90 | 4 ++++ base/MAPL_Comms.F90 | 1 + base/MAPL_LocStreamMod.F90 | 1 + base/MAPL_MemUtils.F90 | 4 ++++ base/MAPL_SwathGridFactory.F90 | 10 ++++++++++ base/ServerManager.F90 | 5 +++++ base/cub2latlon_regridder.F90 | 5 ++++- 7 files changed, 29 insertions(+), 1 deletion(-) diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index bc895330e0c2..dd0f3edd5ca5 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -118,6 +118,7 @@ subroutine initialize_pflogger(unusable,comm,logging_config,rc) else call MPI_COMM_Rank(comm_world,rank,status) + _VERIFY(status) console = StreamHandler(OUTPUT_UNIT) call console%set_level(INFO) call console%set_formatter(MpiFormatter(comm_world, fmt='%(short_name)a10~: %(message)a')) @@ -186,7 +187,9 @@ subroutine report_global_profiler(unusable,comm,rc) call reporter%add_column(exclusive) call MPI_Comm_size(world_comm, npes, ierror) + _VERIFY(ierror) call MPI_Comm_Rank(world_comm, my_rank, ierror) + _VERIFY(ierror) if (my_rank == 0) then report_lines = reporter%generate_report(t_p) @@ -197,6 +200,7 @@ subroutine report_global_profiler(unusable,comm,rc) end do end if call MPI_Barrier(world_comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine report_global_profiler diff --git a/base/MAPL_Comms.F90 b/base/MAPL_Comms.F90 index 58aab4a1f02c..d8a98bc834d9 100644 --- a/base/MAPL_Comms.F90 +++ b/base/MAPL_Comms.F90 @@ -677,6 +677,7 @@ subroutine MAPL_CollectiveWait(request, DstArray, rc) call MPI_Recv(request%Var, size(request%Var), MPI_REAL, & request%Root, request%tag, request%comm, & MPI_STATUS_IGNORE, status) + _VERIFY(status) endif k=0 do J=1,request%JM0 diff --git a/base/MAPL_LocStreamMod.F90 b/base/MAPL_LocStreamMod.F90 index a5628dcc7f53..d0f654f73900 100644 --- a/base/MAPL_LocStreamMod.F90 +++ b/base/MAPL_LocStreamMod.F90 @@ -2741,6 +2741,7 @@ subroutine MAPL_LocStreamCreateXform ( Xform, LocStreamOut, LocStreamIn, NAME, M call MPI_GATHER( lNumReceivers, 1, MPI_INTEGER, & allSenders(:,1), 1, MPI_INTEGER, & I-1, Xform%Ptr%Comm, status ) + _VERIFY(status) enddo end block call ESMF_VMBarrier(vm, rc=status) diff --git a/base/MAPL_MemUtils.F90 b/base/MAPL_MemUtils.F90 index 26a0c331fdee..b96c6b6dd339 100755 --- a/base/MAPL_MemUtils.F90 +++ b/base/MAPL_MemUtils.F90 @@ -403,6 +403,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as) #endif call MPI_Comm_Size(comm_,npes,status) + _VERIFY(status) if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then lhwm = mhwm; call MPI_AllReduce(lhwm,ghwm,1,MPI_REAL,MPI_MAX,comm_,status) _VERIFY(STATUS) @@ -414,6 +415,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) _VERIFY(STATUS) gavg = gavg/npes mstd = (mrss-gavg)**2; call MPI_AllReduce(mstd,gstd,1,MPI_REAL,MPI_SUM,comm_,status) + _VERIFY(STATUS) gstd = sqrt( gstd/npes ) gmax_save = gmax lcommitlimit = commitlimit; call MPI_AllReduce(lcommitlimit,gcommitlimit,1,MPI_REAL,MPI_MAX,comm_,status) @@ -784,6 +786,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc) _RETURN(ESMF_SUCCESS) #endif call MPI_Barrier(comm,status) + _VERIFY(status) if (present(decorator)) then extra_message = decorator else @@ -792,6 +795,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc) call MAPL_MemUsed(mem_total,mem_used,percent_used) call MAPL_MemCommited(committed_total,committed,percent_committed) call MPI_Comm_Rank(comm,rank,status) + _VERIFY(status) if (rank == 0) write(*,'("Mem report ",A20," ",A30," ",i7," ",f5.1,"% : ",f5.1,"% Mem Comm:Used")')trim(extra_message),file_name,line,percent_committed,percent_used end subroutine diff --git a/base/MAPL_SwathGridFactory.F90 b/base/MAPL_SwathGridFactory.F90 index f931fe52a12f..3ae4e633a54d 100644 --- a/base/MAPL_SwathGridFactory.F90 +++ b/base/MAPL_SwathGridFactory.F90 @@ -551,6 +551,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc ! call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC) call MPI_COMM_RANK(mpic, irank, ierror) + _VERIFY(ierror) if (irank==0) & write(6,'(10(2x,a20,2x,a40,/))') & @@ -690,14 +691,21 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc call MPI_bcast(this%M_file, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) do i=1, this%M_file call MPI_bcast(this%filenames(i), ESMF_MAXSTR, MPI_CHARACTER, 0, mpic, ierror) + _VERIFY(ierror) end do call MPI_bcast(this%epoch_index, 4, MPI_INTEGER8, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%im_world, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%jm_world, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%cell_across_swath, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) call MPI_bcast(this%cell_along_swath, 1, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) ! donot need to bcast this%along_track (root only) @@ -1352,6 +1360,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc) call ESMF_VmGetCurrent(VM, _RC) call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC) call MPI_COMM_RANK(mpic, irank, ierror) + _VERIFY(ierror) if (irank==0) then ! xtrack @@ -1406,6 +1415,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc) end if call MPI_bcast(xy_subset, 4, MPI_INTEGER, 0, mpic, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine get_xy_subset diff --git a/base/ServerManager.F90 b/base/ServerManager.F90 index 93f160d475bb..22d679ca92d1 100644 --- a/base/ServerManager.F90 +++ b/base/ServerManager.F90 @@ -153,6 +153,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server if ( index(s_name, 'model') /=0 ) then client_comm = this%split_comm%get_subcommunicator() call MPI_Comm_Rank(client_comm,rank,status) + _VERIFY(status) if (npes_in(1) == 0 .and. nodes_in(1) == 0) profiler_name = "i_server_client" if (npes_out(1) == 0 .and. nodes_out(1) == 0) profiler_name = "o_server_client" if (npes_out(1) == 0 .and. nodes_out(1) == 0 .and. & @@ -194,6 +195,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server call this%directory_service%publish(PortInfo(s_name,this%i_server), this%i_server) call this%directory_service%connect_to_client(s_name, this%i_server) call MPI_Comm_Rank(this%split_comm%get_subcommunicator(),rank,status) + _VERIFY(status) if (rank == 0 .and. nodes_in(1) /=0 ) then write(*,'(A,I0,A)')"Starting pFIO input server on ",nodes_in(i)," nodes" else if (rank==0 .and. npes_in(1) /=0 ) then @@ -210,6 +212,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server endif call mpi_barrier(comm, status) + _VERIFY(status) enddo @@ -246,6 +249,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server call this%directory_service%publish(PortInfo(s_name,this%o_server), this%o_server) call this%directory_service%connect_to_client(s_name, this%o_server) call MPI_Comm_Rank(this%split_comm%get_subcommunicator(),rank,status) + _VERIFY(status) if (rank == 0 .and. nodes_out(1) /=0 ) then write(*,'(A,I0,A)')"Starting pFIO output server on ",nodes_out(i)," nodes" else if (rank==0 .and. npes_out(1) /=0 ) then @@ -262,6 +266,7 @@ subroutine initialize(this, comm, unusable, application_size, nodes_input_server endif call mpi_barrier(comm, status) + _VERIFY(status) enddo diff --git a/base/cub2latlon_regridder.F90 b/base/cub2latlon_regridder.F90 index 2edf278d9b28..3b1d971bb503 100644 --- a/base/cub2latlon_regridder.F90 +++ b/base/cub2latlon_regridder.F90 @@ -559,13 +559,14 @@ function all_gather(local) result(global) integer :: p integer, allocatable :: counts(:) integer, allocatable :: displs(:) - integer :: ierror + integer :: ierror, rc allocate(counts(0:pet_count-1)) allocate(displs(0:pet_count-1)) call mpi_allgather(len(local), 1, MPI_INTEGER, & & counts, 1, MPI_INTEGER, MPI_COMM_WORLD, ierror) + _VERIFY(ierror) displs(0) = 0 do p = 1, pet_count - 1 @@ -575,6 +576,7 @@ function all_gather(local) result(global) allocate(character(len=sum(counts)) :: global) call mpi_allgatherv(local, len(local), MPI_CHAR, & global, counts, displs, MPI_CHAR, MPI_COMM_WORLD, ierror) + _VERIFY(ierror) end function all_gather @@ -600,6 +602,7 @@ subroutine regrid(srcField, dstField, missing, rc) if (present(missing)) then have_missing = any(missing == src_array) call MPI_AllReduce(have_missing, any_missing, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierror) + _VERIFY(ierror) if (any_missing) then local_key = run_length_encode(reshape(src_array,[size(src_array)]) == missing) global_key = all_gather(local_key) From 04f0bd3e3ecc56bf18ebabc293b0a4f57e269478 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 18 Jul 2024 14:09:32 -0400 Subject: [PATCH 12/77] Update to test CI orb --- .circleci/config.yml | 2 +- .github/workflows/workflow.yml | 2 +- CHANGELOG.md | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 998ba2369fc4..4ed1b8bf125e 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -21,7 +21,7 @@ bcs_version: &bcs_version v11.5.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: - ci: geos-esm/circleci-tools@2 + ci: geos-esm/circleci-tools@dev:2212ed5b102cce44add21afe2c1f86f118b92b78 workflows: build-and-test-MAPL: diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index bd6f785f72e6..76ed2d251565 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -86,7 +86,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v7.25.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 diff --git a/CHANGELOG.md b/CHANGELOG.md index 3e887b9b42a1..1ec874e9adbc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - Update Baselibs in CI to 7.25.0 + - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 - Update `components.yaml` - ESMA_cmake v3.48.0 - Update `esma_add_fortran_submodules` function From 4ef155558bd78594ddedc4b6262ee5ee1e46fbaa Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 18 Jul 2024 14:11:20 -0400 Subject: [PATCH 13/77] Update docker build --- .circleci/config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 4ed1b8bf125e..824931357aea 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -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: From 4d08f9ad81bd295a27b46ee0a2fb9312c21ef998 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 18 Jul 2024 14:12:01 -0400 Subject: [PATCH 14/77] make strings --- .circleci/config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 824931357aea..971b878d35ca 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -179,9 +179,9 @@ workflows: baselibs_version: *baselibs_version container_name: mapl mpi_name: intelmpi - mpi_version: 2021.13 + mpi_version: "2021.13" compiler_name: intel - compiler_version: 2024.2 + compiler_version: "2024.2" image_name: geos-env tag_build_arg_name: *tag_build_arg_name - ci/publish_docker: From 1b647fbbd245a78cfa4ccf70a14bb88444f52a9c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 18 Jul 2024 14:48:07 -0400 Subject: [PATCH 15/77] Update orb --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 971b878d35ca..0a1c854571f0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -21,7 +21,7 @@ bcs_version: &bcs_version v11.5.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: - ci: geos-esm/circleci-tools@dev:2212ed5b102cce44add21afe2c1f86f118b92b78 + ci: geos-esm/circleci-tools@2 workflows: build-and-test-MAPL: From 5c8b146b194a777a71ff3edfc698518e51cd30a8 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Thu, 18 Jul 2024 16:14:42 -0400 Subject: [PATCH 16/77] Add VERIFY statements in files in the folder Apps. --- Apps/Regrid_Util.F90 | 1 + Apps/time_ave_util.F90 | 13 +++++++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/Apps/Regrid_Util.F90 b/Apps/Regrid_Util.F90 index 8b4810c4d073..14d6af409fcb 100644 --- a/Apps/Regrid_Util.F90 +++ b/Apps/Regrid_Util.F90 @@ -424,6 +424,7 @@ subroutine main() call t_prof%stop("Read") call MPI_BARRIER(MPI_COMM_WORLD,STATUS) + _VERIFY(status) call t_prof%start("write") diff --git a/Apps/time_ave_util.F90 b/Apps/time_ave_util.F90 index 756c3250e70d..c17b82360863 100644 --- a/Apps/time_ave_util.F90 +++ b/Apps/time_ave_util.F90 @@ -133,9 +133,13 @@ program time_ave !call timebeg ('main') - call mpi_init ( ierror ) ; comm = mpi_comm_world + call mpi_init ( ierror ) + _VERIFY(ierror) + comm = mpi_comm_world call mpi_comm_rank ( comm,myid,ierror ) + _VERIFY(ierror) call mpi_comm_size ( comm,npes,ierror ) + _VERIFY(ierror) call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD, _RC) call MAPL_Initialize(_RC) t_prof = DistributedProfiler('time_ave_util',MpiTImerGauge(),MPI_COMM_WORLD) @@ -813,6 +817,7 @@ program time_ave enddo ! End ntime Loop within file call MPI_BARRIER(comm,status) + _VERIFY(status) enddo do k=0,ntods @@ -1064,7 +1069,9 @@ program time_ave endif call mpi_reduce( qmin(nloc(n)+L-1),qming,1,mpi_real,mpi_min,0,comm,ierror ) + _VERIFY(ierror) call mpi_reduce( qmax(nloc(n)+L-1),qmaxg,1,mpi_real,mpi_max,0,comm,ierror ) + _VERIFY(ierror) if( root ) then if(L.eq.1) then write(6,3101) trim(vname2(n)),plev,qming,qmaxg @@ -1076,6 +1083,7 @@ program time_ave 3102 format(1x,' ',a20,' Level: ',f9.3,' Min: ',g15.8,' Max: ',g15.8) enddo call MPI_BARRIER(comm,status) + _VERIFY(status) if( root ) print * enddo if( root ) print * @@ -1676,7 +1684,7 @@ end function is_leap_year subroutine usage(root) logical, intent(in) :: root - integer :: status,errorcode + integer :: status,errorcode,rc if(root) then write(6,100) 100 format( "usage: ",/,/ & @@ -1710,6 +1718,7 @@ subroutine usage(root) ) endif call MPI_Abort(MPI_COMM_WORLD,errorcode,status) + _VERIFY(status) end subroutine usage subroutine generate_report() From 7cdb36572b7df9c82b9146aff1bff4c49a55650c Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Fri, 19 Jul 2024 12:08:46 -0400 Subject: [PATCH 17/77] Add error checking for MPI calls in the benchmarks folder --- .../checkpoint_simulator.F90 | 125 +++++++++--------- 1 file changed, 65 insertions(+), 60 deletions(-) diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index f2d257c21020..77cc71ae7a6f 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -1,3 +1,4 @@ +#undef I_AM_MAIN #include "MAPL_ErrLog.h" module mapl_checkpoint_support_mod @@ -65,7 +66,7 @@ subroutine set_parameters(this,config_file) type(ESMF_Config) :: config logical :: is_present - integer :: comm_size, status,error_code + integer :: comm_size, status,error_code,rc config = ESMF_ConfigCreate() this%extra_info = .false. @@ -96,8 +97,10 @@ subroutine set_parameters(this,config_file) this%data_volume = 0.d0 this%time_writing = 0.d0 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) + call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,_IERROR) + if (comm_size /= (this%nx*this%ny*6)) then + call MPI_Abort(mpi_comm_world,error_code,_IERROR) + endif contains @@ -173,12 +176,12 @@ subroutine allocate_n_arrays(this,im,jm) integer, intent(in) :: im integer, intent(in) :: jm - integer :: n,rank,status + integer :: n,rank,status,rc character(len=3) :: formatted_int integer :: seed_size integer, allocatable :: seeds(:) - call MPI_COMM_RANK(MPI_COMM_WORLD,rank,status) + call MPI_COMM_RANK(MPI_COMM_WORLD,rank,_IERROR) call random_seed(size=seed_size) allocate(seeds(seed_size)) seeds = rank @@ -199,10 +202,10 @@ subroutine create_arrays(this) class(test_support), intent(inout) :: this integer, allocatable :: ims(:),jms(:) - integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset + integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset,rc - call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) - call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,_IERROR) + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,_IERROR) allocate(this%bundle(this%num_arrays)) ims = this%compute_decomposition(axis=1) jms = this%compute_decomposition(axis=2) @@ -251,16 +254,16 @@ subroutine create_arrays(this) subroutine create_communicators(this) class(test_support), intent(inout) :: this - integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key + integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key,rc local_ny = this%ny*6 - call MPI_Comm_Rank(mpi_comm_world,myid,status) + call MPI_Comm_Rank(mpi_comm_world,myid,_IERROR) nx0 = mod(myid,this%nx) + 1 ny0 = myid/this%nx + 1 color = nx0 - call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,status) + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,_IERROR) color = ny0 - call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,status) + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,_IERROR) ny_by_writers = local_ny/this%num_writers @@ -269,16 +272,16 @@ subroutine create_communicators(this) else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%writers_comm,status) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%writers_comm,_IERROR) if (this%num_writers == local_ny) then this%gather_comm = this%xcomm else j = ny0 - mod(ny0-1,ny_by_writers) - call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm,status) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm, _IERROR) end if - call MPI_BARRIER(mpi_comm_world,status) + call MPI_BARRIER(mpi_comm_world, _IERROR) end subroutine @@ -286,7 +289,7 @@ subroutine create_communicators(this) subroutine close_file(this) class(test_support), intent(inout) :: this - integer :: status + integer :: status, rc integer(kind=INT64) :: sub_start,sub_end @@ -299,7 +302,7 @@ subroutine close_file(this) close(this%ncid) end if end if - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) call system_clock(count=sub_end) this%close_file_time = sub_end-sub_start end subroutine @@ -307,7 +310,7 @@ subroutine close_file(this) subroutine create_file(this) class(test_support), intent(inout) :: this - integer :: status + integer :: status, rc integer :: info integer :: xdim,ydim,zdim,i,varid,create_mode character(len=:), allocatable :: fname @@ -322,16 +325,16 @@ subroutine create_file(this) create_mode = IOR(create_mode,NF90_NETCDF4) create_mode = IOR(create_mode,NF90_SHARE) create_mode = IOR(create_mode,NF90_MPIIO) - call MPI_INFO_CREATE(info,status) - call MPI_INFO_SET(info,"cb_buffer_size","16777216",status) - call MPI_INFO_SET(info,"romio_cb_write","enable",status) + call MPI_INFO_CREATE(info, _IERROR) + call MPI_INFO_SET(info,"cb_buffer_size","16777216", _IERROR) + call MPI_INFO_SET(info,"romio_cb_write","enable", _IERROR) if (this%extra_info) then - call MPI_INFO_SET(info,"IBM_largeblock_io","true",status) - call MPI_INFO_SET(info,"striping_unit","4194304",status) + call MPI_INFO_SET(info,"IBM_largeblock_io","true", _IERROR) + call MPI_INFO_SET(info,"striping_unit","4194304", _IERROR) end if if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank,status) + call MPI_COMM_RANK(this%writers_comm,writer_rank, _IERROR) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".nc4" status = nf90_create(fname,ior(NF90_NETCDF4,NF90_CLOBBER), this%ncid) @@ -368,14 +371,14 @@ subroutine create_file(this) else if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank,status) + call MPI_COMM_RANK(this%writers_comm,writer_rank, _IERROR) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".bin" open(file=fname,newunit=this%ncid,status='replace',form='unformatted',access='sequential') end if end if end if - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) call system_clock(count=sub_end) this%create_file_time = sub_end-sub_start end subroutine @@ -383,13 +386,13 @@ subroutine create_file(this) subroutine write_file(this) class(test_support), intent(inout) :: this - integer :: status,i,l + integer :: status,i,l,rc integer(kind=INT64) :: sub_start,sub_end - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) call system_clock(count=sub_start) - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) do i=1,this%num_arrays if (this%gather_3d) then call this%write_variable(this%bundle(i)%field_name,this%bundle(i)%field) @@ -399,18 +402,18 @@ subroutine write_file(this) enddo end if enddo - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) call system_clock(count=sub_end) - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) this%write_3d_time = sub_end-sub_start - call MPI_BARRIER(MPI_COMM_WORLD,status) + call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) end subroutine subroutine write_variable(this,var_name,local_var) class(test_support), intent(inout) :: this character(len=*), intent(in) :: var_name real, intent(in) :: local_var(:,:,:) - integer :: status + integer :: status,rc real, allocatable :: recvbuf(:) integer :: I,J,N,K,L,myrow,myiorank,ndes_x integer :: start(3), cnt(3) @@ -427,9 +430,9 @@ subroutine write_variable(this,var_name,local_var) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow,status) - call mpi_comm_rank(this%gather_comm,myiorank,status) - call mpi_comm_size(this%gather_comm,num_io_rows,status) + call mpi_comm_rank(this%ycomm,myrow, _IERROR) + call mpi_comm_rank(this%gather_comm,myiorank, _IERROR) + call mpi_comm_size(this%gather_comm,num_io_rows, _IERROR) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -461,7 +464,7 @@ subroutine write_variable(this,var_name,local_var) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%time_mpi = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if(myiorank==0) then @@ -523,7 +526,7 @@ subroutine write_level(this,var_name,local_var,z_index) character(len=*), intent(in) :: var_name real, intent(in) :: local_var(:,:) integer, intent(in) :: z_index - integer :: status + integer :: status, rc real, allocatable :: recvbuf(:) integer :: I,J,N,K,L,myrow,myiorank,ndes_x integer :: start(3), cnt(3) @@ -540,9 +543,9 @@ subroutine write_level(this,var_name,local_var,z_index) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow,status) - call mpi_comm_rank(this%gather_comm,myiorank,status) - call mpi_comm_size(this%gather_comm,num_io_rows,status) + call mpi_comm_rank(this%ycomm,myrow, _IERROR) + call mpi_comm_rank(this%gather_comm,myiorank, _IERROR) + call mpi_comm_size(this%gather_comm,num_io_rows, _IERROR) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -574,7 +577,7 @@ subroutine write_level(this,var_name,local_var,z_index) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%mpi_time = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if(myiorank==0) then @@ -631,16 +634,18 @@ subroutine write_level(this,var_name,local_var,z_index) end module +#define I_AM_MAIN #include "MAPL_ErrLog.h" program checkpoint_tester use ESMF + use MAPL_ErrorHandlingMod + use mapl_checkpoint_support_mod use MPI use NetCDF - use mapl_checkpoint_support_mod use, intrinsic :: iso_fortran_env, only: REAL64, INT64 implicit NONE - integer :: status,rank,writer_size,writer_rank,comm_size,i + integer :: status,rank,writer_size,writer_rank,comm_size,i,rc type(test_support) :: support integer(kind=INT64) :: start_write,end_time,count_rate,start_app,end_app real(kind=REAL64) :: time_sum,write_time,create_time,close_time,write_3d_time,write_2d_time @@ -651,22 +656,22 @@ program checkpoint_tester real(kind=REAL64) :: std_throughput, std_fs_throughput call system_clock(count=start_app,count_rate=count_rate) - call MPI_Init(status) - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Init(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD,_IERROR) - call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) - call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,_IERROR) + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,_IERROR) call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD) - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD,_IERROR) call support%set_parameters("checkpoint_benchmark.rc") - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD,_IERROR) call support%create_arrays() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD,_IERROR) call support%create_communicators() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD,_IERROR) allocate(total_throughput(support%n_trials)) allocate(all_proc_throughput(support%n_trials)) @@ -675,15 +680,15 @@ program checkpoint_tester call support%reset() call system_clock(count=start_write) - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if (support%do_writes) call support%create_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) call support%write_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if (support%do_writes) call support%close_file() - call MPI_Barrier(MPI_COMM_WORLD,status) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) call system_clock(count=end_time) write_time = real(end_time-start_write,kind=REAL64)/real(count_rate,kind=REAL64) @@ -694,11 +699,11 @@ program checkpoint_tester application_time = real(end_time - start_app,kind=REAL64)/real(count_rate,kind=REAL64) if (support%write_counter > 0) then - call MPI_COMM_SIZE(support%writers_comm,writer_size,status) - call MPI_COMM_RANK(support%writers_comm,writer_rank,status) - call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm,status) + call MPI_COMM_SIZE(support%writers_comm,writer_size, _IERROR) + call MPI_COMM_RANK(support%writers_comm,writer_rank, _IERROR) + call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, _IERROR) average_volume = average_volume/real(writer_size,kind=REAL64) - call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm,status) + call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, _IERROR) average_time = average_time/real(writer_size,kind=REAL64) end if if (rank == 0) then From ab58f5651aa5ace319f44fe8bae323a7ed0ae354 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Fri, 19 Jul 2024 15:10:54 -0400 Subject: [PATCH 18/77] Add error checking for MPI calls in the generic folder --- generic/MAPL_Generic.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index c7f59fa19977..d2aa72e8eb92 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -10999,6 +10999,7 @@ subroutine ArrDescrSetNCPar(ArrDes, MPL, tile, offset, num_readers, num_writers, call ArrDescrCreateWriterComm(arrdes,mpl%grid%comm,mpl%grid%num_writers,_RC) call ArrDescrCreateReaderComm(arrdes,mpl%grid%comm,mpl%grid%num_readers,_RC) call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,status) + _VERIFY(status) arrdes%split_restart = mpl%grid%split_restart arrdes%split_checkpoint = mpl%grid%split_checkpoint From e1621b1e69c82610bc158f7d552dc359f74a8ded Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Fri, 19 Jul 2024 16:37:48 -0400 Subject: [PATCH 19/77] Add error checking for MPI calls in the gridcomps folder --- gridcomps/Cap/MAPL_Cap.F90 | 18 +++++++-------- gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 | 6 ++--- .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 22 +++++++++---------- .../Sampler/MAPL_StationSamplerMod.F90 | 11 +++++++--- .../Sampler/MAPL_TrajectoryMod_smod.F90 | 6 +++++ 5 files changed, 34 insertions(+), 29 deletions(-) diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 007d857d6da0..91f5e259ac58 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -285,12 +285,12 @@ subroutine run_model(this, comm, unusable, rc) ! Look for a file called "ESMF.rc" but we want to do this on root and then ! broadcast the result to the other ranks - call MPI_COMM_RANK(comm, rank, ierror) + call MPI_COMM_RANK(comm, rank, _IERROR) if (rank == 0) then inquire(file='ESMF.rc', exist=file_exists) end if - call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, ierror) + call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, _IERROR) ! If the file exists, we pass it into ESMF_Initialize, else, we ! use the one from the command line arguments @@ -348,8 +348,7 @@ subroutine report_throughput(rc) integer :: rank, ierror real(kind=REAL64) :: model_duration, wall_time, model_days_per_day - call MPI_Comm_rank(this%comm_world, rank, ierror) - _VERIFY(ierror) + call MPI_Comm_rank(this%comm_world, rank, _IERROR) if (rank == 0) then model_duration = this%cap_gc%get_model_duration() @@ -452,15 +451,14 @@ subroutine initialize_mpi(this, unusable, rc) call ESMF_InitializePreMPI(_RC) if (.not. this%mpi_already_initialized) then - call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, ierror) + call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, _IERROR) _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.') -! call MPI_Init_thread(MPI_THREAD_SINGLE, provided, ierror) -! _VERIFY(ierror) +! call MPI_Init_thread(MPI_THREAD_SINGLE, provided, _IERROR) ! _ASSERT(provided == MPI_THREAD_SINGLE, "MPI_THREAD_SINGLE not supported by this MPI.") end if - call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror) - call MPI_Comm_size(this%comm_world, npes_world, ierror); _VERIFY(ierror) + call MPI_Comm_rank(this%comm_world, this%rank, _IERROR) + call MPI_Comm_size(this%comm_world, npes_world, _IERROR) if ( this%cap_options%npes_model == -1) then ! just a feed back to cap_options to maintain integrity @@ -499,7 +497,7 @@ subroutine finalize_mpi(this, unusable, rc) call MAPL_Finalize(comm=this%comm_world) if (.not. this%mpi_already_initialized) then - call MPI_Finalize(status) + call MPI_Finalize(_IERROR) end if _RETURN(_SUCCESS) diff --git a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 index baf74b993de5..5ea428c898d9 100644 --- a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 +++ b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 @@ -147,8 +147,7 @@ subroutine initialize_p0(model, import_state, export_state, clock, rc) mpiCommunicator=mpi_comm, rc=status) _VERIFY(status) - !call MPI_Comm_dup(mpi_comm, dup_comm, status) - !_VERIFY(status) + !call MPI_Comm_dup(mpi_comm, dup_comm, _IERROR) dup_comm = mpi_comm cap_params = get_cap_parameters_from_gc(model, status) @@ -160,8 +159,7 @@ subroutine initialize_p0(model, import_state, export_state, clock, rc) cap_options%comm = dup_comm ! cap_options%logging_config = "logging.yaml" cap_options%logging_config = '' - call MPI_Comm_size(dup_comm, cap_options%npes_model, status) - _VERIFY(status) + call MPI_Comm_size(dup_comm, cap_options%npes_model, _IERROR) allocate(cap) cap = MAPL_Cap(cap_params%name, cap_params%set_services, & diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index 3e9aa6d9a11f..beceb000b4bd 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -340,7 +340,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end do call MPI_gatherv ( nx2, 1, MPI_INTEGER, & this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) if (.not. mapl_am_i_root()) then this%recvcounts(:) = 0 end if @@ -352,10 +352,10 @@ module subroutine create_Geosat_grid_find_mask(this, rc) nsend = nx2 call MPI_gatherv ( lons_chunk, nsend, MPI_REAL8, & lons, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & lats, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) !! if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx @@ -389,14 +389,12 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ptA(:) = lons_chunk(:) call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) + call MPI_Barrier(mpic,_IERROR) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lons_ds = ptB ptA(:) = lats_chunk(:) - call MPI_Barrier(mpic,ierr) - _VERIFY (ierr) + call MPI_Barrier(mpic,_IERROR) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lats_ds = ptB @@ -524,7 +522,7 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end do call MPI_gatherv ( this%npt_mask, 1, MPI_INTEGER, & this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) if (.not. mapl_am_i_root()) then this%recvcounts(:) = 0 end if @@ -539,10 +537,10 @@ module subroutine create_Geosat_grid_find_mask(this, rc) nsend=this%npt_mask call MPI_gatherv ( lons, nsend, MPI_REAL8, & this%lons, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) call MPI_gatherv ( lats, nsend, MPI_REAL8, & this%lats, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) call MAPL_TimerOff(this%GENSTATE,"4_gatherV") @@ -730,7 +728,7 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(item%xname,p_dst_2d_full,& @@ -754,7 +752,7 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx * nz call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & p_dst_3d_full, recvcounts_3d, displs_3d, MPI_REAL,& - iroot, mpic, ierr ) + iroot, mpic, _IERROR ) call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then allocate(arr(nz, this%npt_mask_tot), _STAT) diff --git a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 index 8a94d5ef5665..ab394566122c 100644 --- a/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 +++ b/gridcomps/History/Sampler/MAPL_StationSamplerMod.F90 @@ -1,4 +1,5 @@ #include "MAPL_Generic.h" +#include "MAPL_ErrLog.h" module StationSamplerMod use ESMF use MAPL_ErrorHandlingMod @@ -287,10 +288,12 @@ function new_StationSampler_readfile (bundle, filename, nskip_line, GENSTATE, rc call MPI_Scatterv( sampler%lons, sendcount, & displs, MPI_REAL8, lons_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( sampler%lats, sendcount, & displs, MPI_REAL8, lats_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) ! -- root sampler%LSF = LocStreamFactory(sampler%lons, sampler%lats, _RC) @@ -618,6 +621,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_chunk_2d, nsend, MPI_REAL, & p_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then @@ -640,11 +644,11 @@ subroutine append_file(this,current_time,rc) call MAPL_TimerOff(this%GENSTATE,"3d_regrid") call MPI_Barrier(mpic,ierr) - _VERIFY (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) + _VERIFY(ierr) call MAPL_TimerOff(this%GENSTATE,"FieldRedist") @@ -656,7 +660,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) + _VERIFY(ierr) end do deallocate(p_dst_t) p_rt_3d = reshape(p_rt_3d_aux, shape(p_rt_3d), order=[2,1]) @@ -664,6 +668,7 @@ subroutine append_file(this,current_time,rc) call MPI_gatherv ( p_chunk_3d, nsend_v, MPI_REAL, & p_rt_3d, recvcount_v, displs_v, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) end if call MAPL_TimerOff(this%GENSTATE,"gatherv") diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 1ca959172e5c..dc4e8f258851 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -891,14 +891,17 @@ call MPI_Scatterv( this%lons, sendcount, & displs, MPI_REAL8, lons_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( this%lats, sendcount, & displs, MPI_REAL8, lats_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) call MPI_Scatterv( this%times_R8, sendcount, & displs, MPI_REAL8, times_R8_chunk, & recvcount, MPI_REAL8, 0, mpic, ierr) + _VERIFY(ierr) ! -- root this%locstream_factory = LocStreamFactory(this%lons,this%lats,_RC) @@ -1072,6 +1075,7 @@ call MPI_gatherv ( p_acc_chunk_2d, nsend, MPI_REAL, & p_acc_rt_2d, recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(ierr) if (mapl_am_i_root()) then ! @@ -1136,12 +1140,14 @@ call MPI_gatherv ( p_dst_t(1,k), nsend, MPI_REAL, & p_acc_rt_3d(1,k), recvcount, displs, MPI_REAL,& iroot, mpic, ierr ) + _VERIFY(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 ) + _VERIFY(ierr) p_acc_rt_3d = reshape ( p_dst_rt, shape(p_acc_rt_3d), order=[2,1] ) end if From 9d33fdebd31cc3b5b60044a678da794ffb494b87 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Fri, 19 Jul 2024 19:35:14 -0400 Subject: [PATCH 20/77] Add error checking for MPI calls in the pfio folder --- pfio/AbstractServer.F90 | 3 +- pfio/ClientManager.F90 | 1 + pfio/DirectoryService.F90 | 51 ++++++++++++++++-- pfio/MpiMutex.F90 | 58 +++++++++++---------- pfio/MpiSocket.F90 | 10 ++++ pfio/MultiCommServer.F90 | 64 +++++++++++------------ pfio/MultiGroupServer.F90 | 66 ++++++++++++------------ pfio/MultiLayerServer.F90 | 20 +++---- pfio/RDMAReference.F90 | 2 + pfio/ServerThread.F90 | 1 + pfio/ShmemReference.F90 | 10 ++++ pfio/pfio_base.F90 | 7 ++- pfio/pfio_collective_demo.F90 | 24 +++++---- pfio/pfio_parallel_netcdf_reproducer.F90 | 13 +++-- pfio/pfio_server_demo.F90 | 25 +++++---- pfio/pfio_writer.F90 | 43 +++++++-------- 16 files changed, 243 insertions(+), 155 deletions(-) diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 968c47904a89..41185b46d47b 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -357,7 +357,7 @@ function get_writing_PE(this,id) result (rank) class(AbstractServer),intent(in) :: this integer, intent(in) :: id integer :: rank - integer :: rank_tmp, ierror + integer :: rank_tmp, ierror, rc integer :: node_rank,innode_rank logical :: yes @@ -371,6 +371,7 @@ function get_writing_PE(this,id) result (rank) rank = 0 if (yes) rank_tmp = this%rank call Mpi_Allreduce(rank_tmp,rank,1, MPI_INTEGER, MPI_SUM, this%comm, ierror) + _VERIFY(ierror) end function get_writing_PE diff --git a/pfio/ClientManager.F90 b/pfio/ClientManager.F90 index 337e1de710f4..cbafb8473bd4 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -109,6 +109,7 @@ function new_ClientManager(client_comm, unusable, n_client, fast_oclient, rc) re c_manager%client_comm = client_comm call MPI_Comm_rank(client_comm, c_manager%rank, rc) + _VERIFY(rc) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end function new_ClientManager diff --git a/pfio/DirectoryService.F90 b/pfio/DirectoryService.F90 index 47a4cde92ad6..93c5eea0513f 100644 --- a/pfio/DirectoryService.F90 +++ b/pfio/DirectoryService.F90 @@ -114,6 +114,7 @@ function new_DirectoryService(comm, unusable, rc) result(ds) ! Need to be sure that the directories have been initialized before ! proceeding call MPI_Barrier(comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end function new_DirectoryService @@ -129,16 +130,18 @@ integer function make_directory_window(comm, addr) result(win) #if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif - integer :: ierror, rank + integer :: ierror, rank, rc, status - call MPI_Comm_Rank(comm, rank, ierror) + call MPI_Comm_Rank(comm, rank, _IERROR) if (rank == 0) then sz = sizeof_directory() #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Alloc_mem(sz, MPI_INFO_NULL, addr, ierror) + _VERIFY(ierror) #else call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + _VERIFY(ierror) addr = transfer(baseaddr, addr) #endif call c_f_pointer(addr, dir) @@ -147,7 +150,7 @@ integer function make_directory_window(comm, addr) result(win) dir =>dirnull endif - call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, ierror) + call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, _IERROR) end function make_directory_window @@ -205,6 +208,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser end do call MPI_Comm_rank(client_comm, rank_in_client, ierror) + _VERIFY(ierror) if (rank_in_client == 0) then @@ -232,6 +236,7 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser dir_entry%port_name = port_name call MPI_Comm_rank(this%comm, dir_entry%partner_root_rank, ierror) ! global comm + _VERIFY(ierror) dir%entries(n) = dir_entry @@ -245,12 +250,14 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser else call MPI_Recv(server_root_rank, 1, MPI_INTEGER, MPI_ANY_SOURCE, DISCOVERY_TAG, this%comm, status, ierror) end if + _VERIFY(ierror) end if ! complete handshake if (rank_in_client == 0) then call MPI_Comm_size(client_comm, client_npes, ierror) + _VERIFY(ierror) allocate(client_ranks(client_npes)) allocate(server_ranks(client_npes)) else @@ -259,22 +266,29 @@ subroutine connect_to_server(this, port_name, client, client_comm, unusable, ser end if call MPI_Gather(this%rank, 1, MPI_INTEGER, client_ranks, 1, MPI_INTEGER, 0, client_comm, ierror) + _VERIFY(ierror) if (rank_in_client == 0) then call MPI_Send(client_npes, 1, MPI_INTEGER, server_root_rank, NPES_TAG, this%comm, ierror) + _VERIFY(ierror) call MPI_Send(client_ranks, client_npes, MPI_INTEGER, server_root_rank, RANKS_TAG, this%comm, ierror) + _VERIFY(ierror) call MPI_Recv(server_ranks, client_npes, MPI_INTEGER, server_root_rank, 0, this%comm, status, ierror) + _VERIFY(ierror) call MPI_Recv(server_npes, 1, MPI_INTEGER, server_root_rank, 0, this%comm, status, ierror) + _VERIFY(ierror) if (present(server_size)) server_size = server_npes end if call MPI_Scatter(server_ranks, 1, MPI_INTEGER, & & server_rank, 1, MPI_INTEGER, & & 0, client_comm, ierror) + _VERIFY(ierror) if (present(server_size)) call MPI_Bcast(server_size, 1, MPI_INTEGER, 0, client_comm,ierror) ! Construct the connection call MPI_Recv(tmp_rank, 1, MPI_INTEGER, server_rank, CONNECT_TAG, this%comm, status, ierror) + _VERIFY(ierror) _ASSERT(tmp_rank == server_rank, "shake the wrong hand") allocate(sckt, source=MpiSocket(this%comm, server_rank, this%parser)) @@ -321,6 +335,7 @@ subroutine connect_to_client(this, port_name, server, rc) endif call MPI_Comm_rank(server_comm, rank_in_server, ierror) + _VERIFY(ierror) if (rank_in_server == 0) then @@ -355,11 +370,14 @@ subroutine connect_to_client(this, port_name, server, rc) else call MPI_Recv(client_root_rank, 1, MPI_INTEGER, MPI_ANY_SOURCE, DISCOVERY_TAG, this%comm, status, ierror) end if + _VERIFY(ierror) if (client_root_rank /= TERMINATE) then ! not a termination signal call MPI_Recv(client_npes, 1, MPI_INTEGER, client_root_rank, NPES_TAG, this%comm, status, ierror) + _VERIFY(ierror) allocate(client_ranks(client_npes)) call MPI_Recv(client_ranks, client_npes, MPI_INTEGER, client_root_rank, RANKS_TAG, this%comm, status, ierror) + _VERIFY(ierror) else client_npes = TERMINATE end if @@ -368,7 +386,9 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_Comm_size(server_comm, server_npes, ierror) + _VERIFY(ierror) call MPI_Bcast(client_npes, 1, MPI_INTEGER, 0, server_comm, ierror) + _VERIFY(ierror) if (client_npes == TERMINATE) then server%terminate = .true. @@ -394,10 +414,13 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_GatherV(my_server_ranks, cnts, MPI_INTEGER, & & server_ranks, counts, displs, MPI_INTEGER, & & 0, server_comm, ierror) + _VERIFY(ierror) if (rank_in_server == 0) then call MPI_Send(server_ranks, client_npes, MPI_INTEGER, client_root_rank, 0, this%comm, ierror) + _VERIFY(ierror) call MPI_Send(server_npes, 1, MPI_INTEGER, client_root_rank, 0, this%comm, ierror) + _VERIFY(ierror) endif if (rank_in_server /= 0) then @@ -406,10 +429,12 @@ subroutine connect_to_client(this, port_name, server, rc) call MPI_ScatterV(client_ranks, counts, displs, MPI_INTEGER, & & my_client_ranks, cnts, MPI_INTEGER, & & 0, server_comm, ierror) + _VERIFY(ierror) do p = 1, cnts client_rank = my_client_ranks(p) call MPI_Send(this%rank, 1, MPI_INTEGER, client_rank, CONNECT_TAG, this%comm, ierror) + _VERIFY(ierror) allocate(sckt, source=MpiSocket(this%comm, client_rank, this%parser)) call server%add_connection(sckt) nullify(sckt) @@ -448,6 +473,7 @@ subroutine publish(this, port, server, rc) endif call MPI_Comm_rank(server_comm, rank_in_server, ierror) + _VERIFY(ierror) port_name = port%port_name if (rank_in_server == 0) then @@ -520,15 +546,18 @@ function get_directory(this, win) result(dir) integer :: sz integer(kind=MPI_ADDRESS_KIND) :: disp - integer :: ierror + integer :: ierror, rc call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win, ierror) + _VERIFY(ierror) sz = sizeof_directory() disp = 0 call MPI_Get(dir, sz, MPI_BYTE, 0, disp, sz, MPI_BYTE, win, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, win, ierror) + _VERIFY(ierror) return _UNUSED_DUMMY(this) end function get_directory @@ -541,16 +570,19 @@ subroutine put_directory(this, dir, win) integer :: sz integer(kind=MPI_ADDRESS_KIND) :: disp - integer :: ierror + integer :: ierror, rc call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win, ierror) + _VERIFY(ierror) sz = sizeof_directory() disp = 0 call MPI_put(dir, sz, MPI_BYTE, 0, disp, sz, MPI_BYTE, win, ierror) + _VERIFY(ierror) call MPI_Win_unlock(0, win, ierror) + _VERIFY(ierror) return _UNUSED_DUMMY(this) end subroutine put_directory @@ -564,8 +596,10 @@ subroutine terminate_servers(this, client_comm, rc) integer :: ierror, rank_in_client,i call MPI_Comm_rank(client_comm, rank_in_client, ierror) + _VERIFY(ierror) call MPI_BARRIER(client_comm,ierror) + _VERIFY(ierror) if (rank_in_client ==0) then @@ -577,6 +611,7 @@ subroutine terminate_servers(this, client_comm, rc) call MPI_Send(TERMINATE, 1, MPI_INTEGER, dir%entries(i)%partner_root_rank, DISCOVERY_TAG, & & this%comm, ierror) + _VERIFY(ierror) enddo @@ -594,20 +629,26 @@ subroutine free_directory_resources(this, rc) ! Release resources call MPI_Barrier(this%comm, ierror) + _VERIFY(ierror) call this%mutex%free_mpi_resources() call MPI_Win_free(this%win_server_directory, ierror) + _VERIFY(ierror) call MPI_Win_free(this%win_client_directory, ierror) + _VERIFY(ierror) if (this%rank == 0) then call c_f_pointer(this%server_dir, dir) call MPI_Free_mem(dir, ierror) + _VERIFY(ierror) call c_f_pointer(this%client_dir, dir) call MPI_Free_mem(dir, ierror) + _VERIFY(ierror) end if call Mpi_Comm_free(this%comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine free_directory_resources diff --git a/pfio/MpiMutex.F90 b/pfio/MpiMutex.F90 index 956638ef2102..913ee49779f2 100644 --- a/pfio/MpiMutex.F90 +++ b/pfio/MpiMutex.F90 @@ -1,8 +1,10 @@ ! Lifted from logger project and renamed from MpiLock. Tests were not ! brought over, but was tested using MockMpi prototype. +#include "MAPL_ErrLog.h" module pFIO_MpiMutexMod use mpi + use MAPL_ErrorHandlingMod use iso_c_binding, only: c_ptr, c_f_pointer implicit none private @@ -37,15 +39,15 @@ function new_MpiMutex(comm) result(lock) type (MpiMutex) :: lock integer, intent(in) :: comm - integer :: ierror + integer :: ierror,rc,status integer(kind=MPI_ADDRESS_KIND) :: sz #if !defined (SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif - call MPI_Comm_dup(comm, lock%comm, ierror) - call MPI_Comm_rank(lock%comm, lock%rank, ierror) - call MPI_Comm_size(lock%comm, lock%npes, ierror) + call MPI_Comm_dup(comm, lock%comm, _IERROR) + call MPI_Comm_rank(lock%comm, lock%rank, _IERROR) + call MPI_Comm_size(lock%comm, lock%npes, _IERROR) ! This type is used to copy the status of locks on other PE's ! into a table that can be examined on the local process. @@ -54,8 +56,8 @@ function new_MpiMutex(comm) result(lock) integer :: displs(2) blklens = [lock%rank, lock%npes - lock%rank - 1] displs = [0, lock%rank + 1] - call MPI_Type_indexed(2, blklens, displs, MPI_LOGICAL, lock%pe_locks_type, ierror); - call MPI_Type_commit(lock%pe_locks_type, ierror) + call MPI_Type_indexed(2, blklens, displs, MPI_LOGICAL, lock%pe_locks_type, _IERROR); + call MPI_Type_commit(lock%pe_locks_type, _IERROR) end block ! Create windows @@ -65,12 +67,12 @@ function new_MpiMutex(comm) result(lock) logical, pointer :: scratchpad(:) integer :: sizeof_logical - call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, ierror) + call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, _IERROR) sz = lock%npes * sizeof_logical #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) - call MPI_Alloc_mem(sz, MPI_INFO_NULL, lock%locks_ptr, ierror) + call MPI_Alloc_mem(sz, MPI_INFO_NULL, lock%locks_ptr, _IERROR) #else - call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, _IERROR) lock%locks_ptr = transfer(baseaddr, lock%locks_ptr) #endif @@ -78,14 +80,14 @@ function new_MpiMutex(comm) result(lock) scratchpad = .false. call MPI_Win_create(scratchpad, sz, sizeof_logical, & - & MPI_INFO_NULL, lock%comm, lock%window, ierror) + & MPI_INFO_NULL, lock%comm, lock%window, _IERROR) end block else ! local window memory is size 0, but have to pass something block logical :: buffer(1) sz = 0 - call MPI_Win_create(buffer, sz, 1, MPI_INFO_NULL, lock%comm, lock%window, ierror) + call MPI_Win_create(buffer, sz, 1, MPI_INFO_NULL, lock%comm, lock%window, _IERROR) end block end if @@ -98,22 +100,22 @@ end function new_MpiMutex subroutine acquire(this) class (MpiMutex), intent(inout) :: this - integer :: ierror + integer :: ierror,rc,status - call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, _IERROR) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & - & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, _IERROR) call MPI_Put(.true., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & - & 1, MPI_LOGICAL, this%window, ierror) + & 1, MPI_LOGICAL, this%window, _IERROR) - call MPI_Win_unlock(0, this%window, ierror) + call MPI_Win_unlock(0, this%window, _IERROR) ! Check other processes for holding the lock if (any(this%local_data)) then ! wait for signal from process with the lock block integer :: buffer ! unused call MPI_Recv(buffer, 0, MPI_LOGICAL, MPI_ANY_SOURCE, & - & LOCK_TAG, this%comm, MPI_STATUS_IGNORE, ierror) + & LOCK_TAG, this%comm, MPI_STATUS_IGNORE, _IERROR) end block end if @@ -124,14 +126,14 @@ end subroutine acquire subroutine release(this) class (MpiMutex), intent(inout) :: this - integer :: ierror + integer :: ierror,rc,status - call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, _IERROR) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & - & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, _IERROR) call MPI_Put(.false., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & - & 1, MPI_LOGICAL, this%window, ierror) - call MPI_Win_unlock(0, this%window, ierror) + & 1, MPI_LOGICAL, this%window, _IERROR) + call MPI_Win_unlock(0, this%window, _IERROR) ! who needs the lock next (if anyone)? block @@ -155,7 +157,7 @@ subroutine release(this) if (next_rank /= -1) then call MPI_Send(buffer, 0, MPI_LOGICAL, next_rank, & - & LOCK_TAG, this%comm, ierror) + & LOCK_TAG, this%comm, _IERROR) end if end block @@ -165,17 +167,17 @@ subroutine free_mpi_resources(this) class (MpiMutex), intent(inout) :: this logical, pointer :: scratchpad(:) - integer :: ierror + integer :: ierror,rc,status ! Release resources - call MPI_Type_free(this%pe_locks_type, ierror) - call MPI_Win_free(this%window, ierror) + call MPI_Type_free(this%pe_locks_type, _IERROR) + call MPI_Win_free(this%window, _IERROR) if (this%rank == 0) then call c_f_pointer(this%locks_ptr, scratchpad, [this%npes]) - call MPI_Free_mem(scratchpad, ierror) + call MPI_Free_mem(scratchpad, _IERROR) end if - call Mpi_comm_free(this%comm, ierror) + call Mpi_comm_free(this%comm, _IERROR) end subroutine free_mpi_resources diff --git a/pfio/MpiSocket.F90 b/pfio/MpiSocket.F90 index b7b6d7a60c49..a0e5098d2772 100644 --- a/pfio/MpiSocket.F90 +++ b/pfio/MpiSocket.F90 @@ -78,9 +78,11 @@ function new_MpiSocket(comm, remote_rank, parser, rc) result(s) s%world_remote_rank = remote_rank call MPI_Comm_rank(comm, local_rank, ierror) + _VERIFY(ierror) s%world_local_rank = local_rank call MPI_Comm_group(comm, world_group, ierror) + _VERIFY(ierror) ! Enforce consistent ordering in new communicator/group if (local_rank < remote_rank) then @@ -93,7 +95,9 @@ function new_MpiSocket(comm, remote_rank, parser, rc) result(s) s%pair_remote_rank = 0 end if call MPI_Group_incl(world_group, 2, ranks, pair_group, ierror) + _VERIFY(ierror) call MPI_Comm_create_group(comm, pair_group, PAIR_TAG, s%pair_comm, ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end function new_MpiSocket @@ -108,11 +112,14 @@ function receive(this, rc) result(message) integer :: count call MPI_Probe(this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, status, ierror) + _VERIFY(ierror) call MPI_Get_count(status, MPI_INTEGER, count, ierror) + _VERIFY(ierror) allocate(buffer(count)) call MPI_Recv(buffer, count, MPI_INTEGER, this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, & & status, ierror) + _VERIFY(ierror) allocate(message, source=this%parser%decode(buffer)) _RETURN(_SUCCESS) @@ -129,6 +136,7 @@ subroutine send(this, message, rc) buffer = this%parser%encode(message) call MPI_Send(buffer, size(buffer), MPI_INTEGER, this%pair_remote_rank, MESSAGE_TAG, this%pair_comm, & & ierror) + _VERIFY(ierror) _RETURN(_SUCCESS) end subroutine send @@ -165,6 +173,7 @@ function put(this, request_id, local_reference, rc) result(handle) call c_f_pointer(local_reference%base_address, data, shape=[n_words]) if (n_words ==0) allocate(data(1)) call MPI_Isend(data, n_words, MPI_INTEGER, this%pair_remote_rank, tag, this%pair_comm, request, ierror) + _VERIFY(ierror) allocate(handle, source=MpiRequestHandle(local_reference, request)) if (n_words ==0) deallocate(data) _RETURN(_SUCCESS) @@ -190,6 +199,7 @@ function get(this, request_id, local_reference, rc) result(handle) call c_f_pointer(local_reference%base_address, data, shape=[n_words]) if (n_words ==0) allocate(data(1)) call MPI_Irecv(data, n_words, MPI_INTEGER, this%pair_remote_rank, tag, this%pair_comm, request, ierror) + _VERIFY(ierror) allocate(handle, source=MpiRequestHandle(local_reference, request)) if (n_words ==0) deallocate(data) _RETURN(_SUCCESS) diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index 3b0afb0f13e2..d08d0a53a526 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -89,7 +89,7 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul integer, allocatable :: node_sizes(:) s%server_comm = server_comm - call MPI_Comm_size(s%server_comm, s_size , ierror) + call MPI_Comm_size(s%server_comm, s_size , _IERROR) s%splitter = SimpleCommsplitter(s%server_comm) node_sizes = s%splitter%get_node_sizes() @@ -107,7 +107,7 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul allocate(s%back_ranks(nwriter)) allocate(s%front_ranks(s%nfront)) - call MPI_Comm_rank(s%server_comm, s_rank, ierror) + call MPI_Comm_rank(s%server_comm, s_rank, _IERROR) s_name = s_comm%get_name() s%I_am_front_root = .false. s%I_am_back_root = .false. @@ -115,36 +115,36 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul s%front_comm = s_comm%get_subcommunicator() call s%init(s%front_comm, s_name) s%port_name = trim(port_name) - call MPI_Comm_rank(s%front_comm, local_rank, ierror) + call MPI_Comm_rank(s%front_comm, local_rank, _IERROR) if (s_rank == 0) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") s%I_am_front_root = .true. - call MPI_recv(s%back_ranks, nwriter, MPI_INTEGER, MPI_ANY_SOURCE, 666, s%server_comm, MPI_STAT,ierror) + call MPI_recv(s%back_ranks, nwriter, MPI_INTEGER, MPI_ANY_SOURCE, 666, s%server_comm, MPI_STAT,_IERROR) endif - call MPI_Bcast(s%back_ranks, nwriter, MPI_INTEGER, 0, s%front_comm, ierror) + call MPI_Bcast(s%back_ranks, nwriter, MPI_INTEGER, 0, s%front_comm, _IERROR) - call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%front_ranks, 1, MPI_INTEGER, s%front_comm, ierror) + call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%front_ranks, 1, MPI_INTEGER, s%front_comm, _IERROR) if (local_rank ==0 ) then - call MPI_Send(s%front_ranks, s_size-nwriter, MPI_INTEGER, s%back_ranks(1), 777, s%server_comm, ierror) + call MPI_Send(s%front_ranks, s_size-nwriter, MPI_INTEGER, s%back_ranks(1), 777, s%server_comm, _IERROR) endif endif if (index(s_name, 'o_server_back') /=0) then s%back_comm = s_comm%get_subcommunicator() - call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%back_ranks, 1, MPI_INTEGER, s%back_comm, ierror) - call MPI_Comm_rank(s%back_comm, local_rank, ierror) + call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%back_ranks, 1, MPI_INTEGER, s%back_comm, _IERROR) + call MPI_Comm_rank(s%back_comm, local_rank, _IERROR) if (local_rank ==0 ) then s%I_am_back_root = .true. - call MPI_Send(s%back_ranks, nwriter, MPI_INTEGER, 0, 666, s%server_comm, ierror) + call MPI_Send(s%back_ranks, nwriter, MPI_INTEGER, 0, 666, s%server_comm, _IERROR) endif if (s_rank == s%back_ranks(1)) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") - call MPI_recv(s%front_ranks, s%nfront, MPI_INTEGER, MPI_ANY_SOURCE, 777, s%server_comm, MPI_STAT,ierror) + call MPI_recv(s%front_ranks, s%nfront, MPI_INTEGER, MPI_ANY_SOURCE, 777, s%server_comm, MPI_STAT,_IERROR) endif - call MPI_Bcast(s%front_ranks, s%nfront, MPI_INTEGER, 0, s%back_comm, ierror) + call MPI_Bcast(s%front_ranks, s%nfront, MPI_INTEGER, 0, s%back_comm, _IERROR) call s%set_status(1) call s%add_connection(dummy_socket) endif @@ -173,13 +173,13 @@ subroutine start_back(rc) integer :: ierr integer :: my_rank, cmd, status - call MPI_Comm_rank(this%server_comm, my_rank, ierr) + call MPI_Comm_rank(this%server_comm, my_rank, _IERROR) allocate(this%serverthread_done_msgs(1)) this%serverthread_done_msgs(:) = .false. do while (.true.) - call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) if (cmd == -1) exit call this%create_remote_win(_RC) call this%receive_output_data(_RC) @@ -227,7 +227,7 @@ subroutine start_front(rc) enddo call this%threads%clear() - call MPI_Bcast(terminate, 1, MPI_INTEGER, 0, this%server_comm, ierr) + call MPI_Bcast(terminate, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) deallocate(mask) _RETURN(_SUCCESS) end subroutine start_front @@ -258,12 +258,12 @@ subroutine create_remote_win(this, rc) integer :: MPI_STAT(MPI_STATUS_SIZE) character(len=*),parameter :: Iam = 'create_remote_win' class (ServerThread),pointer :: thread_ptr - integer :: bsize, ierr + integer :: bsize, ierr, status integer :: cmd = 1 integer, allocatable :: buffer(:) if (this%front_comm /= MPI_COMM_NULL) then - call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) endif this%stage_offset = StringInteger64map() @@ -273,13 +273,13 @@ subroutine create_remote_win(this, rc) if (this%I_am_front_root) then call serialize_message_vector(thread_ptr%request_backlog,buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) - call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) + call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) call HistoryCollectionVector_serialize(thread_ptr%hist_collections, buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) - call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) + call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) endif @@ -287,30 +287,30 @@ subroutine create_remote_win(this, rc) if (this%I_am_back_root) then call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) endif - call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, _IERROR) if (.not. allocated(buffer)) allocate(buffer(bsize)) - call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, _IERROR) call deserialize_message_vector(buffer, thread_ptr%request_backlog) deallocate (buffer) if (this%I_am_back_root) then call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) endif - call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, _IERROR) if (.not. allocated(buffer)) allocate(buffer(bsize)) - call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, _IERROR) call HistoryCollectionVector_deserialize(buffer, thread_ptr%hist_collections) deallocate (buffer) endif @@ -380,7 +380,7 @@ subroutine put_DataToFile(this, rc) class (AbstractDataReference), pointer :: dataRefPtr type (LocalMemReference), pointer :: memdataPtr=>null() integer(kind=MPI_ADDRESS_KIND) :: msize - integer :: num_clients, l_rank, w_rank, ierr, empty(0) + integer :: num_clients, l_rank, w_rank, ierr, empty(0), status !real(KIND=REAL64) :: t0, t1 !t0 = 0.0d0 @@ -393,7 +393,7 @@ subroutine put_DataToFile(this, rc) if (this%back_comm /= MPI_COMM_NULL) then - call MPI_comm_rank(this%back_comm, l_rank, ierr) + call MPI_comm_rank(this%back_comm, l_rank, _IERROR) ! copy and save the data do collection_counter = 1, this%dataRefPtrs%size() dataRefPtr => this%get_dataReference(collection_counter) @@ -463,7 +463,7 @@ subroutine clean_up(this, rc) if (this%back_Comm /= MPI_COMM_NULL) then ! time to write file - call MPI_comm_rank(this%back_comm, l_rank, ierr) + call MPI_comm_rank(this%back_comm, l_rank, _IERROR) threadPtr=>this%threads%at(1) msg_iter = threadPtr%request_backlog%begin() diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index 77da6fb43348..67e7f5b3afa3 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -386,12 +386,12 @@ subroutine receive_output_data(this, rc) ! root asks for idle writer and sends axtra file metadata if (this%I_am_front_root) then collection_id = collection_ids%at(collection_counter) - call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, _IERROR) msg =>f_d_ms(collection_counter)%msg_vec%at(1) ! just pick first one. All messages should have the same filename select type (q=>msg) class is (AbstractCollectiveDataMessage) Filename = q%file_name - call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, _IERROR) class default _FAIL( "yet to implemented") end select @@ -401,28 +401,28 @@ subroutine receive_output_data(this, rc) call hist_collection%fmd%serialize(buffer) endif - call Mpi_Bcast( collection_id, 1, MPI_INTEGER, 0, this%front_comm, ierror) + call Mpi_Bcast( collection_id, 1, MPI_INTEGER, 0, this%front_comm, _IERROR) if (associated(ioserver_profiler)) call ioserver_profiler%start("collection_"//i_to_string(collection_id)) if (this%I_am_front_root) then call Mpi_Recv(back_local_rank, 1, MPI_INTEGER, this%back_ranks(1), & - this%front_ranks(1), this%server_comm, MPI_STAT, ierror) + this%front_ranks(1), this%server_comm, MPI_STAT, _IERROR) msg_size= size(buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, ierror) + this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) call Mpi_send(buffer,msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, ierror) + this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) endif - call Mpi_Bcast( back_local_rank, 1, MPI_INTEGER, 0, this%front_comm, ierror) - if (allocated(this%buffers(back_local_rank+1)%buffer)) call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, ierror) + call Mpi_Bcast( back_local_rank, 1, MPI_INTEGER, 0, this%front_comm, _IERROR) + if (allocated(this%buffers(back_local_rank+1)%buffer)) call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, _IERROR) call f_d_ms(collection_counter)%serialize(this%buffers(back_local_rank+1)%buffer) call f_d_ms(collection_counter)%destroy(_RC) msg_size= size(this%buffers(back_local_rank+1)%buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, ierror) + this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) call Mpi_Isend(this%buffers(back_local_rank+1)%buffer, msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(back_local_rank+1)%request,ierror) if (associated(ioserver_profiler)) call ioserver_profiler%stop("collection_"//i_to_string(collection_id)) @@ -482,12 +482,12 @@ subroutine start_back_captain(rc) ! 1) captain node of back_comm is waiting command from front_comm call MPI_recv( collection_id, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) if (collection_id == -1) exit call MPI_recv( FileName, FNAME_LEN , MPI_CHARACTER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) ! 2) get an idle processor and notify front root call dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc=status) _VERIFY(status) @@ -499,7 +499,7 @@ subroutine start_back_captain(rc) ! at the end , send done message to root of oserver ! this serves the syncronization with oserver terminate = -1 - call MPI_send(terminate, 1, MPI_INTEGER, 0, 0, this%server_comm, ierr) + call MPI_send(terminate, 1, MPI_INTEGER, 0, 0, this%server_comm, _IERROR) deallocate(num_idlePEs, idleRank) _RETURN(_SUCCESS) end subroutine start_back_captain @@ -527,11 +527,11 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) ! non block probe writers do local_rank = 1, this%nwriter-1 flag = .false. - call MPI_Iprobe( local_rank, stag, this%back_comm, flag, MPI_STAT, ierr) + call MPI_Iprobe( local_rank, stag, this%back_comm, flag, MPI_STAT, _IERROR) if (flag) then call MPI_recv(idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") node_rank = this%node_ranks(local_rank) num_idlePEs(node_rank) = num_idlePEs(node_rank) + 1 @@ -540,7 +540,7 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) call MPI_recv(FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) iter = FilesBeingWritten%find(FileDone) _ASSERT( iter /= FilesBeingWritten%end(), "FileDone should be in the set") @@ -570,10 +570,10 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) ! 2.2) tell front comm which idel_worker is ready call MPI_send(idle_writer, 1, MPI_INTEGER, this%front_ranks(1), & - this%front_ranks(1), this%server_comm, ierr) + this%front_ranks(1), this%server_comm, _IERROR) ! 2.3) forward the collection_id to the idle_writer - call MPI_send(collection_id, 1, MPI_INTEGER, idle_writer, idle_writer,this%back_comm, ierr) + call MPI_send(collection_id, 1, MPI_INTEGER, idle_writer, idle_writer,this%back_comm, _IERROR) _RETURN(_SUCCESS) end subroutine dispatch_work @@ -593,17 +593,17 @@ subroutine terminate_back_writers(idleRank, rc) if (idleRank(node_rank, nth_writer) >=1) then ! send no_job directly to terminate - call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, _IERROR) else ! For busy worker, wait to receive idle_writer and the send no_job call MPI_recv( idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) call MPI_recv( FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") - call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, _IERROR) endif enddo _RETURN(_SUCCESS) @@ -651,7 +651,7 @@ subroutine start_back_writers(rc) ! 1) get collection id from captain call MPI_recv( collection_id, 1, MPI_INTEGER, & 0, back_local_rank, this%back_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) if (collection_id == -1 ) exit ! exit when get terminate signal !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! sync with create_remote_win from front_com @@ -662,21 +662,21 @@ subroutine start_back_writers(rc) if (i == 1) then call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) allocate(buffer_fmd(msg_size)) call MPI_recv( buffer_fmd(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) endif call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) if (allocated(this%buffers(i)%buffer)) deallocate (this%buffers(i)%buffer) allocate(this%buffers(i)%buffer(msg_size)) call MPI_Irecv( this%buffers(i)%buffer(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(i)%request, & - ierr) + _IERROR) enddo ! nfront ! re-org data @@ -687,7 +687,7 @@ subroutine start_back_writers(rc) do i = 1, this%nfront s0 = 1 f_d_m = ForwardDataAndMessage() - call MPI_Wait(this%buffers(i)%request, MPI_STAT, ierr) + call MPI_Wait(this%buffers(i)%request, MPI_STAT, _IERROR) call f_d_m%deserialize(this%buffers(i)%buffer) deallocate(this%buffers(i)%buffer) if (size(f_d_m%idata) ==0) cycle @@ -855,9 +855,9 @@ subroutine start_back_writers(rc) ! telling captain it is idle by sending its own rank !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , ierr) + call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , _IERROR) FileDone = Filename - call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , ierr) + call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , _IERROR) enddo _RETURN(_SUCCESS) end subroutine start_back_writers @@ -868,14 +868,14 @@ subroutine terminate_backend_server(this, rc) class (MultiGroupServer), intent(inout) :: this integer, optional, intent(out) :: rc integer :: terminate - integer :: ierr, i + integer :: ierr, i, status integer :: MPI_STAT(MPI_STATUS_SIZE) terminate = -1 ! starting from 2, no backend root do i = 2, this%nwriter if (allocated(this%buffers(i)%buffer)) then - call MPI_Wait(this%buffers(i)%request, MPI_STAT, ierr) + call MPI_Wait(this%buffers(i)%request, MPI_STAT, _IERROR) _VERIFY(ierr) endif enddo @@ -884,10 +884,10 @@ subroutine terminate_backend_server(this, rc) ! The back root send terminate back for synchronization if (this%I_am_front_root) then call MPI_send(terminate, 1, MPI_INTEGER, this%back_ranks(1), & - this%back_ranks(1), this%server_comm, ierr) + this%back_ranks(1), this%server_comm, _IERROR) _VERIFY(ierr) call MPI_recv(terminate, 1, MPI_INTEGER, this%back_ranks(1), & - this%front_ranks(1), this%server_comm, MPI_STAT, ierr) + this%front_ranks(1), this%server_comm, MPI_STAT, _IERROR) _VERIFY(ierr) endif _RETURN(_SUCCESS) diff --git a/pfio/MultiLayerServer.F90 b/pfio/MultiLayerServer.F90 index 4e8e45c8da72..6d232f47ca96 100644 --- a/pfio/MultiLayerServer.F90 +++ b/pfio/MultiLayerServer.F90 @@ -119,14 +119,14 @@ end subroutine start subroutine terminate_writers(this) class (MultiLayerServer), intent(inout) :: this integer :: terminate = -1 - integer :: ierr + integer :: ierr, status, rc integer :: MPI_STAT(MPI_STATUS_SIZE) ! The root rank sends termination signal to the root of the spawned children which would ! send terminate back for synchronization ! if no syncrohization, the writer may be still writing while the main testing node is comparing if( this%rank == 0 .and. this%nwriters > 1 ) then - call MPI_send(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) - call MPI_recv(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, MPI_STAT, ierr) + call MPI_send(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_recv(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, MPI_STAT, _IERROR) endif end subroutine terminate_writers @@ -217,7 +217,7 @@ subroutine put_DataToFile(this, rc) call forwardVec%clear() call forData%clear() endif - call MPI_Barrier(this%comm, status) + call MPI_Barrier(this%comm, _IERROR) endif ! first thread n==1 call threadPtr%clear_backlog() call threadPtr%clear_hist_collections() @@ -243,18 +243,18 @@ subroutine forward_DataToWriter(forwardVec, forwardData, rc) call serialize_message_vector(forwardVec,buffer) bsize = size(buffer) - call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) + call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, _IERROR) call MPI_recv(writer_rank, 1, MPI_INTEGER, & 0, pFIO_s_tag, this%Inter_Comm , & - MPI_STAT, ierr) + MPI_STAT, _IERROR) !forward Message - call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) - call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) !send number of collections call StringAttributeMap_serialize(forwardData,buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) - call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) !2) send the data _RETURN(_SUCCESS) diff --git a/pfio/RDMAReference.F90 b/pfio/RDMAReference.F90 index 5b556391188a..ce3c07b59541 100644 --- a/pfio/RDMAReference.F90 +++ b/pfio/RDMAReference.F90 @@ -48,6 +48,7 @@ function new_RDMAReference(type_kind,msize_word,comm, rank, rc) result(reference reference%msize_word = msize_word reference%type_kind = type_kind call Mpi_comm_dup(Comm,reference%comm,status) + _VERIFY(status) reference%mem_rank = rank call reference%allocate(rc=status) _VERIFY(status) @@ -123,6 +124,7 @@ subroutine allocate(this, rc) n_bytes = this%msize_word * int_size call MPI_Comm_rank(this%comm,Rank,status) + _VERIFY(status) windowsize = 0_MPI_ADDRESS_KIND if (Rank == this%mem_rank) windowsize = n_bytes diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index d7c9b31299b2..02cd5f5da63b 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -389,6 +389,7 @@ function read_and_gather(this, rc) result(dataRefPtr) call MPI_AllGATHERV(locals, local_size, MPI_INTEGER, & i_ptr, int(offsets), int(g_offsets), MPI_INTEGER, & this%containing_server%NodeRoot_Comm,status) + _VERIFY(status) deallocate(locals) endif diff --git a/pfio/ShmemReference.F90 b/pfio/ShmemReference.F90 index b71ced10ea91..3c2683bf4b96 100644 --- a/pfio/ShmemReference.F90 +++ b/pfio/ShmemReference.F90 @@ -45,6 +45,7 @@ function new_ShmemReference(type_kind,msize_word,InNode_Comm, rc) result(referen reference%msize_word = msize_word reference%type_kind = type_kind call Mpi_comm_dup(InNode_Comm,reference%InNode_Comm,status) + _VERIFY(status) call reference%allocate(rc=status) _VERIFY(status) @@ -117,6 +118,7 @@ subroutine allocate(this, rc) n_bytes = this%msize_word * 4_MPI_ADDRESS_KIND call MPI_Comm_rank(this%InNode_Comm,InNode_Rank,ierr) + _VERIFY(ierr) disp_unit = 1 windowsize = 0_MPI_ADDRESS_KIND @@ -125,18 +127,22 @@ subroutine allocate(this, rc) #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, this%InNode_Comm, & this%base_address, this%win, ierr) + _VERIFY(ierr) #else call MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, this%InNode_Comm, & baseaddr, this%win, ierr) + _VERIFY(ierr) this%base_address = transfer(baseaddr, this%base_address) #endif if (InNode_Rank /= 0) then #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) call MPI_Win_shared_query(this%win, 0, windowsize, disp_unit, this%base_address,ierr) + _VERIFY(ierr) #else call MPI_Win_shared_query(this%win, 0, windowsize, disp_unit, baseaddr,ierr) this%base_address = transfer(baseaddr, this%base_address) + _VERIFY(ierr) #endif endif @@ -154,8 +160,11 @@ subroutine deallocate(this, rc) endif call MPI_Win_fence(0, this%win, ierr) + _VERIFY(ierr) call MPI_Win_free(this%win,ierr) + _VERIFY(ierr) call MPI_Comm_free(this%InNode_Comm, ierr) + _VERIFY(ierr) this%shmem_allocated = .false. _RETURN(_SUCCESS) end subroutine deallocate @@ -169,6 +178,7 @@ subroutine fence(this, rc) _RETURN(_SUCCESS) endif call Mpi_Win_fence(0, this%win, ierr) + _VERIFY(ierr) _RETURN(_SUCCESS) end subroutine fence diff --git a/pfio/pfio_base.F90 b/pfio/pfio_base.F90 index b35b4516f8f6..f52de98e5ce5 100644 --- a/pfio/pfio_base.F90 +++ b/pfio/pfio_base.F90 @@ -1,14 +1,17 @@ +#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module pfio_base + use MAPL_ErrorHandlingMod integer, save :: debug_unit = 0 contains subroutine pfio_init() use MPI character(len=5) :: buf - integer :: rank, ierror + integer :: rank, ierror, rc, status if (debug_unit == 0) then - call MPI_Comm_rank(MPI_Comm_world, rank, ierror) + call MPI_Comm_rank(MPI_Comm_world, rank, _IERROR) write(buf,'(i5.5)') rank open(newunit=debug_unit,file='pfio_debug.'//buf,status='unknown', form='formatted') end if diff --git a/pfio/pfio_collective_demo.F90 b/pfio/pfio_collective_demo.F90 index 82c8a34955bb..4eea79957438 100644 --- a/pfio/pfio_collective_demo.F90 +++ b/pfio/pfio_collective_demo.F90 @@ -114,6 +114,8 @@ end subroutine process_command_line end module collective_demo_CLI +!#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module FakeExtDataMod_collective use, intrinsic :: iso_fortran_env, only: INT64 use MAPL_ExceptionHandling @@ -165,7 +167,7 @@ subroutine init(this, options, comm, d_s, port_name) class (AbstractDirectoryService), target,intent(inout) :: d_s character(*), intent(in) :: port_name - integer :: ierror + integer :: ierror, status, rc type (FileMetadata) :: file_metadata type (NetCDF4_FileFormatter) :: formatter type (StringIntegerMap) :: dims @@ -182,8 +184,10 @@ subroutine init(this, options, comm, d_s, port_name) this%comm = comm - call MPI_Comm_rank(comm,this%rank,ierror) - call MPI_Comm_size(comm,this%npes,ierror) + call MPI_Comm_rank(comm,this%rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(comm,this%npes, ierror) + _VERIFY(ierror) allocate(this%bundle(this%vars%size())) @@ -293,6 +297,8 @@ end subroutine finalize end module FakeExtDataMod_collective +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mpi use pFIO @@ -302,7 +308,7 @@ program main implicit none integer :: rank, npes, ierror, provided,required - integer :: status, color, key + integer :: status, color, key, rc class(AbstractServer),pointer :: server class(AbstractDirectoryService), pointer :: d_s => null() @@ -317,9 +323,9 @@ program main type (FakeExtData), target :: extData required = MPI_THREAD_MULTIPLE - call MPI_init_thread(required, provided, ierror) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + call MPI_init_thread(required, provided, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) call process_command_line(options, rc=status) @@ -336,7 +342,7 @@ program main color = split_color(options%server_type,options%npes_server) key = 0 - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, _IERROR) if (color == SERVER_COLOR .or. color == BOTH_COLOR) then ! server @@ -354,7 +360,7 @@ program main end if - call MPI_finalize(ierror) + call MPI_finalize(_IERROR) contains diff --git a/pfio/pfio_parallel_netcdf_reproducer.F90 b/pfio/pfio_parallel_netcdf_reproducer.F90 index a7a812b2a27b..790c4cde0898 100644 --- a/pfio/pfio_parallel_netcdf_reproducer.F90 +++ b/pfio/pfio_parallel_netcdf_reproducer.F90 @@ -1,17 +1,20 @@ +#undef I_AM_MAIN +#include "MAPL_ErrLog.h" program main use MPI use FLAP use pFIO + use MAPL_ErrorHandlingMod implicit none - integer :: ierror + integer :: ierror, rc type (command_line_interface) :: cli integer :: im integer :: lm integer :: n_fields character(:), allocatable :: output_filename - call MPI_Init(ierror) + call MPI_Init(_IERROR) call cli%init(description='potential reproducer of parallel netcdf problem on SCU12') call add_cli_options(cli) @@ -19,7 +22,7 @@ program main call run(im, lm, n_fields, output_filename) - call MPI_Finalize(ierror) + call MPI_Finalize(_IERROR) contains @@ -84,8 +87,8 @@ subroutine run(im, lm, n_fields, output_filename) character(:), allocatable :: field_name character(3) :: field_idx_str - call mpi_comm_size(MPI_COMM_WORLD, npes, ierror) - call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror) + call mpi_comm_size(MPI_COMM_WORLD, npes, _IERROR) + call mpi_comm_rank(MPI_COMM_WORLD, rank, _IERROR) jm = im*6 ! pseudo cubed sphere call metadata%add_dimension('IM_WORLD', im) diff --git a/pfio/pfio_server_demo.F90 b/pfio/pfio_server_demo.F90 index a03a54c234f9..9c9a60e81e37 100644 --- a/pfio/pfio_server_demo.F90 +++ b/pfio/pfio_server_demo.F90 @@ -117,7 +117,10 @@ end subroutine process_command_line end module server_demo_CLI +!#undef I_AM_MAIN +#include "MAPL_ErrLog.h" module FakeExtDataMod_server + use MAPL_ExceptionHandling use server_demo_CLI use pFIO use gFTL_StringVector @@ -165,7 +168,7 @@ subroutine init(this, options, comm, d_s) integer, intent(in) :: comm class (AbstractDirectoryService), target,intent(inout) :: d_s - integer :: ierror + integer :: ierror, rc, status type (FileMetadata) :: file_metadata type (NetCDF4_FileFormatter) :: formatter type (StringIntegerMap) :: dims @@ -178,8 +181,10 @@ subroutine init(this, options, comm, d_s) this%vars = options%requested_variables this%comm = comm - call MPI_Comm_rank(comm,this%rank,ierror) - call MPI_Comm_size(comm,this%npes,ierror) + call MPI_Comm_rank(comm,this%rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(comm,this%npes, ierror) + _VERIFY(ierror) allocate(this%bundle(this%vars%size())) @@ -262,6 +267,8 @@ end subroutine finalize end module FakeExtDataMod_server +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mpi use pFIO @@ -271,7 +278,7 @@ program main implicit none integer :: rank, npes, ierror, provided - integer :: status, color, key + integer :: status, color, key, rc class(BaseServer),allocatable :: s @@ -284,9 +291,9 @@ program main type (FakeExtData), target :: extData class(AbstractDirectoryService), pointer :: d_s=>null() - call MPI_init_thread(MPI_THREAD_MULTIPLE, provided, ierror) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + call MPI_init_thread(MPI_THREAD_MULTIPLE, provided, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) call process_command_line(options, rc=status) @@ -298,7 +305,7 @@ program main end if key = 0 - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, _IERROR) !C$ num_threads = 20 allocate(d_s, source = DirectoryService(MPI_COMM_WORLD)) @@ -328,7 +335,7 @@ program main !call global_directory_service%terminate_servers(comm) end if - call MPI_finalize(ierror) + call MPI_finalize(_IERROR) end program main diff --git a/pfio/pfio_writer.F90 b/pfio/pfio_writer.F90 index 7feb925a69c1..2b79e003e269 100644 --- a/pfio/pfio_writer.F90 +++ b/pfio/pfio_writer.F90 @@ -1,3 +1,4 @@ +#define I_AM_MAIN #include "MAPL_ErrLog.h" #include "unused_dummy.H" @@ -22,7 +23,7 @@ program main implicit none integer :: Inter_Comm - integer :: ierr + integer :: ierr, rc integer :: rank integer :: server_rank @@ -41,10 +42,10 @@ program main type (StringNetCDF4_FileFormatterMapIterator) :: iter class (AbstractMessage), pointer :: msg - call MPI_Init(ierr) - call MPI_Comm_get_parent(Inter_Comm, ierr); - call MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) - call MPI_Comm_size(MPI_COMM_WORLD,n_workers, ierr) + call MPI_Init(_IERROR) + call MPI_Comm_get_parent(Inter_Comm, _IERROR); + call MPI_Comm_rank(MPI_COMM_WORLD,rank, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD,n_workers, _IERROR) allocate(busy(n_workers-1), source =0) @@ -54,7 +55,7 @@ program main ! 1) captain node is waiting command from server call MPI_recv( command, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_s_tag, Inter_Comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) server_rank = MPI_STAT(MPI_SOURCE) if (command == 1) then ! server is asking for a writing node @@ -73,27 +74,27 @@ program main call MPI_recv( idle, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_w_m_tag , MPI_COMM_WORLD, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) idle_worker = idle endif ! tell server the idel_worker - call MPI_send(idle_worker, 1, MPI_INTEGER, server_rank, pFIO_s_tag, Inter_Comm, ierr) + call MPI_send(idle_worker, 1, MPI_INTEGER, server_rank, pFIO_s_tag, Inter_Comm, _IERROR) busy(idle_worker) = 1 ! tell the idle_worker which server has work - call MPI_send(server_rank, 1, MPI_INTEGER, idle_worker, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + call MPI_send(server_rank, 1, MPI_INTEGER, idle_worker, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) else ! command /=1, notify the worker to quit and finalize no_job = -1 do i = 1, n_workers -1 if ( busy(i) == 0) then - call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) else call MPI_recv( idle, 1, MPI_INTEGER, & i, pFIO_w_m_tag, MPI_COMM_WORLD, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) if (idle /= i ) stop ("idle should be i") - call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) endif enddo exit @@ -107,7 +108,7 @@ program main ! 1) get server_rank from captain call MPI_recv( server_rank, 1, MPI_INTEGER, & 0, pFIO_m_w_tag, MPI_COMM_WORLD, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) if (server_rank == -1 ) exit !--------------------------------------------------- @@ -115,20 +116,20 @@ program main !--------------------------------------------------- call MPI_recv( msg_size, 1, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) allocate(bufferm(msg_size)) call MPI_recv( bufferm, msg_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) call MPI_recv( data_size, 1, MPI_INTEGER,& server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) allocate(bufferd(data_size)) call MPI_recv( bufferd, data_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, ierr) + MPI_STAT, _IERROR) ! deserilize message and data call deserialize_message_vector(bufferm, forwardVec) @@ -167,21 +168,21 @@ program main deallocate(bufferd, bufferm) ! telling captain, I am the soldier that is ready to have more work - call MPI_send(rank, 1, MPI_INTEGER, 0, pFIO_w_m_tag, MPI_COMM_WORLD , ierr) + call MPI_send(rank, 1, MPI_INTEGER, 0, pFIO_w_m_tag, MPI_COMM_WORLD , _IERROR) enddo endif - call MPI_Barrier(MPI_COMM_WORLD, ierr) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if ( rank == 0) then ! send done message to server ! this serves the syncronization with oserver command = -1 - call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, Inter_Comm, ierr) + call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, Inter_Comm, _IERROR) endif - call MPI_Finalize(ierr) + call MPI_Finalize(_IERROR) contains From cdccb82b5cdb5c9c5c89af89cbe1ca6780d4d279 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Sun, 21 Jul 2024 15:29:37 -0400 Subject: [PATCH 21/77] Add error checking after MPI calls in the profiler folder. --- profiler/AbstractMeter.F90 | 8 +++++++- profiler/DistributedMeter.F90 | 27 +++++++++++++++++---------- profiler/VmstatMemoryGauge.F90 | 6 ++++-- profiler/demo/demo.F90 | 9 ++++++--- profiler/demo/mpi_demo.F90 | 15 +++++++++------ 5 files changed, 43 insertions(+), 22 deletions(-) diff --git a/profiler/AbstractMeter.F90 b/profiler/AbstractMeter.F90 index 7c91982c1b62..f88030251b60 100644 --- a/profiler/AbstractMeter.F90 +++ b/profiler/AbstractMeter.F90 @@ -1,5 +1,7 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_AbstractMeter + use MAPL_ErrorHandlingMod use, intrinsic :: iso_fortran_env, only: REAL64 implicit none private @@ -60,14 +62,18 @@ end subroutine i_accumulate subroutine finalize(this, rc) class(AbstractMeter), intent(in) :: this integer, optional, intent(out) :: rc - integer :: ierror + integer :: ierror, status ierror = 0 if (dist_initialized) then call MPI_type_free(type_dist_struct, ierror) + _VERIFY(ierror) call MPI_type_free(type_dist_real64, ierror) + _VERIFY(ierror) call MPI_type_free(type_dist_integer, ierror) + _VERIFY(ierror) call MPI_Op_free(dist_reduce_op,ierror) + _VERIFY(ierror) dist_initialized = .false. endif if (present(rc)) rc = ierror diff --git a/profiler/DistributedMeter.F90 b/profiler/DistributedMeter.F90 index dcac1341552e..b7981338824c 100644 --- a/profiler/DistributedMeter.F90 +++ b/profiler/DistributedMeter.F90 @@ -1,7 +1,9 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_DistributedMeter use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_ErrorHandlingMod use MAPL_AbstractMeter use MAPL_AdvancedMeter use MAPL_AbstractGauge @@ -140,12 +142,13 @@ subroutine initialize(ierror) type (DistributedMeter) :: dummy logical :: commute + integer :: rc, status call dummy%make_mpi_type(dummy%statistics, type_dist_struct, ierror) - call MPI_Type_commit(type_dist_struct, ierror) + call MPI_Type_commit(type_dist_struct, _IERROR) commute = .true. - call MPI_Op_create(true_reduce, commute, dist_reduce_op, ierror) + call MPI_Op_create(true_reduce, commute, dist_reduce_op, _IERROR) end subroutine initialize @@ -276,8 +279,9 @@ subroutine reduce_mpi(this, comm, exclusive) integer :: rank type(DistributedStatistics) :: tmp + integer :: rc, status - call MPI_Comm_rank(comm, rank, ierror) + call MPI_Comm_rank(comm, rank, _IERROR) this%statistics%total = DistributedReal64(this%get_total(), rank) this%statistics%exclusive = DistributedReal64(exclusive, rank) @@ -287,7 +291,7 @@ subroutine reduce_mpi(this, comm, exclusive) this%statistics%num_cycles = DistributedInteger(this%get_num_cycles(), rank) tmp = this%statistics - call MPI_Reduce(tmp, this%statistics, 1, type_dist_struct, dist_reduce_op, 0, comm, ierror) + call MPI_Reduce(tmp, this%statistics, 1, type_dist_struct, dist_reduce_op, 0, comm, _IERROR) end subroutine reduce_mpi @@ -300,13 +304,14 @@ subroutine make_mpi_type_distributed_real64(this, r64, new_type, ierror) integer(kind=MPI_ADDRESS_KIND) :: displacements(2) integer(kind=MPI_ADDRESS_KIND) :: lb, sz + integer :: rc, status _UNUSED_DUMMY(this) _UNUSED_DUMMY(r64) - call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, ierror) + call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, _IERROR) displacements = [0_MPI_ADDRESS_KIND, 3*sz] - call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, ierror) + call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, _IERROR) end subroutine make_mpi_type_distributed_real64 @@ -318,11 +323,12 @@ subroutine make_mpi_type_distributed_integer(this, int, new_type, ierror) integer, intent(out) :: ierror integer(kind=MPI_ADDRESS_KIND) :: displacements(1) + integer :: rc, status _UNUSED_DUMMY(this) _UNUSED_DUMMY(int) displacements = [0_MPI_ADDRESS_KIND] - call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, ierror) + call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, _IERROR) end subroutine make_mpi_type_distributed_integer @@ -335,15 +341,16 @@ subroutine make_mpi_type_distributed_data(this, d, new_type, ierror) integer(kind=MPI_ADDRESS_KIND) :: displacements(2) integer(kind=MPI_ADDRESS_KIND) :: lb, sz, sz2 + integer :: rc, status _UNUSED_DUMMY(d) call this%make_mpi_type(this%statistics%total, type_dist_real64, ierror) call this%make_mpi_type(this%statistics%num_cycles, type_dist_integer, ierror) - call MPI_Type_get_extent_x(type_dist_real64, lb, sz, ierror) + call MPI_Type_get_extent_x(type_dist_real64, lb, sz, _IERROR) displacements = [0_MPI_ADDRESS_KIND, 6*sz] - call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, ierror) - call MPI_Type_get_extent_x(new_type, lb, sz2, ierror) + call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, _IERROR) + call MPI_Type_get_extent_x(new_type, lb, sz2, _IERROR) end subroutine make_mpi_type_distributed_data diff --git a/profiler/VmstatMemoryGauge.F90 b/profiler/VmstatMemoryGauge.F90 index 30b203d03fd9..65ad7170b7f7 100644 --- a/profiler/VmstatMemoryGauge.F90 +++ b/profiler/VmstatMemoryGauge.F90 @@ -1,5 +1,7 @@ #include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_VmstatMemoryGauge + use MAPL_ErrorHandlingMod use, intrinsic :: iso_fortran_env, only: REAL64, INT64 use MAPL_AbstractGauge implicit none @@ -40,8 +42,8 @@ function get_measurement(this) result(mem_use) _UNUSED_DUMMY(this) block use MPI - integer :: rank, ierror - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + integer :: rank, ierror, status, rc + call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) allocate(character(4) :: tmp_file) write(tmp_file,'(i4.4)')rank tmp_file = 'tmp_' // tmp_file // '.dat' diff --git a/profiler/demo/demo.F90 b/profiler/demo/demo.F90 index 3ea422c138c4..66fb2b7351e4 100644 --- a/profiler/demo/demo.F90 +++ b/profiler/demo/demo.F90 @@ -1,6 +1,9 @@ +#define I_AM_MAIN +638 #include "MAPL_ErrLog.h" program main use MPI use MAPL_Profiler + use MAPL_ErrorHandlingMod implicit none @@ -12,9 +15,9 @@ program main character(:), allocatable :: report_lines(:) integer :: i - integer :: ierror + integer :: ierror, rc, status - call MPI_Init(ierror) + call MPI_Init(_IERROR) main_prof = TimeProfiler('TOTAL') ! timer 1 call main_prof%start() lap_prof = TimeProfiler('Lap') @@ -85,7 +88,7 @@ program main write(*,'(a)') '' - call MPI_Finalize(ierror) + call MPI_Finalize(_IERROR) !call mem_prof%finalize() !report_lines = mem_reporter%generate_report(mem_prof) diff --git a/profiler/demo/mpi_demo.F90 b/profiler/demo/mpi_demo.F90 index 3fcad3a91caa..e6fad5513997 100644 --- a/profiler/demo/mpi_demo.F90 +++ b/profiler/demo/mpi_demo.F90 @@ -1,5 +1,8 @@ +#define I_AM_MAIN +#include "MAPL_ErrLog.h" program main use mapl_Profiler + use MAPL_ErrorHandlingMod use MPI implicit none @@ -12,13 +15,13 @@ program main character(:), allocatable :: report_lines(:) integer :: i - integer :: rank, ierror + integer :: rank, ierror, rc, status character(1) :: empty(0) !$ mem_prof = MemoryProfiler('TOTAL') - call MPI_Init(ierror) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + call MPI_Init(_IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) main_prof = DistributedProfiler('TOTAL', MpiTimerGauge(), MPI_COMM_WORLD) ! timer 1 call main_prof%start() @@ -108,7 +111,7 @@ program main end do write(*,'(a)') '' end if - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) if (rank == 1) then write(*,'(a)')'Final profile (1)' write(*,'(a)')'================' @@ -117,7 +120,7 @@ program main end do write(*,'(a)') '' end if - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD, _IERROR) report_lines = main_reporter%generate_report(main_prof) if (rank == 0) then @@ -140,7 +143,7 @@ program main !$ write(*,'(a)') '' !$ end if - call MPI_Finalize(ierror) + call MPI_Finalize(_IERROR) contains From b9cb0f0f4158d9a3fe31122116d0e278e1ea65da Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Sun, 21 Jul 2024 16:26:05 -0400 Subject: [PATCH 22/77] Add error checking after MPI calls in the Tests folder. --- Tests/ExtDataDriverMod.F90 | 1 + Tests/pfio_MAPL_demo.F90 | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/Tests/ExtDataDriverMod.F90 b/Tests/ExtDataDriverMod.F90 index 757398872933..bf64d653f577 100644 --- a/Tests/ExtDataDriverMod.F90 +++ b/Tests/ExtDataDriverMod.F90 @@ -217,6 +217,7 @@ subroutine initialize_mpi(this, unusable, rc) _UNUSED_DUMMY(unusable) call MPI_Init(ierror) + _VERIFY(ierror) this%comm_world=MPI_COMM_WORLD call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror) diff --git a/Tests/pfio_MAPL_demo.F90 b/Tests/pfio_MAPL_demo.F90 index 6afd8867d56f..aa1a57b57361 100755 --- a/Tests/pfio_MAPL_demo.F90 +++ b/Tests/pfio_MAPL_demo.F90 @@ -1,4 +1,4 @@ - +#define I_AM_MAIN #include "MAPL_ErrLog.h" #include "unused_dummy.H" !------------------------------------------------------------------------------ @@ -91,7 +91,7 @@ program main ! Initialize MPI if MPI_Init has not been called call initialize_mpi(MPI_COMM_WORLD) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) if ( cap_options%npes_model == -1) then cap_options%npes_model = npes endif @@ -112,10 +112,10 @@ program main CALL ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE, mpiCommunicator=client_comm, rc=status) ! Get the number of PEs used for the model - call MPi_Comm_size(client_comm, npes, ierror) + call MPi_Comm_size(client_comm, npes, _IERROR) ! Get the PE id - call MPI_Comm_rank(client_comm, pe_id, ierror) + call MPI_Comm_rank(client_comm, pe_id, _IERROR) if (npes /= cap_options%npes_model) stop "sanity check failed" !------------------------------------------------ @@ -155,7 +155,7 @@ program main call ioserver_manager%finalize() - call MPI_finalize(ierror) + call MPI_finalize(_IERROR) !------------------------------------------------------------------------------ CONTAINS From dfe0b03a28f3bbc2743809922044ba2a3e1541b3 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Mon, 22 Jul 2024 09:39:50 -0400 Subject: [PATCH 23/77] Remove _IERROR as argument but use instead _VERIFY(ierror) statements in the pfio folder. --- pfio/DirectoryService.F90 | 6 +- pfio/MpiMutex.F90 | 72 ++++++++++++------ pfio/MultiCommServer.F90 | 89 ++++++++++++++-------- pfio/MultiGroupServer.F90 | 95 ++++++++++++++++-------- pfio/MultiLayerServer.F90 | 27 ++++--- pfio/pfio_base.F90 | 3 +- pfio/pfio_collective_demo.F90 | 14 ++-- pfio/pfio_parallel_netcdf_reproducer.F90 | 11 ++- pfio/pfio_server_demo.F90 | 14 ++-- pfio/pfio_writer.F90 | 59 ++++++++++----- 10 files changed, 258 insertions(+), 132 deletions(-) diff --git a/pfio/DirectoryService.F90 b/pfio/DirectoryService.F90 index 93c5eea0513f..fe5d321a3c78 100644 --- a/pfio/DirectoryService.F90 +++ b/pfio/DirectoryService.F90 @@ -132,7 +132,8 @@ integer function make_directory_window(comm, addr) result(win) #endif integer :: ierror, rank, rc, status - call MPI_Comm_Rank(comm, rank, _IERROR) + call MPI_Comm_Rank(comm, rank, ierror) + _VERIFY(ierror) if (rank == 0) then sz = sizeof_directory() @@ -150,7 +151,8 @@ integer function make_directory_window(comm, addr) result(win) dir =>dirnull endif - call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, _IERROR) + call MPI_Win_create(dir, sz, 1, MPI_INFO_NULL, comm, win, ierror) + _VERIFY(ierror) end function make_directory_window diff --git a/pfio/MpiMutex.F90 b/pfio/MpiMutex.F90 index 913ee49779f2..bfb902aee629 100644 --- a/pfio/MpiMutex.F90 +++ b/pfio/MpiMutex.F90 @@ -45,9 +45,12 @@ function new_MpiMutex(comm) result(lock) integer(kind=MPI_ADDRESS_KIND) :: baseaddr #endif - call MPI_Comm_dup(comm, lock%comm, _IERROR) - call MPI_Comm_rank(lock%comm, lock%rank, _IERROR) - call MPI_Comm_size(lock%comm, lock%npes, _IERROR) + call MPI_Comm_dup(comm, lock%comm, ierror) + _VERIFY(ierror) + call MPI_Comm_rank(lock%comm, lock%rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(lock%comm, lock%npes, ierror) + _VERIFY(ierror) ! This type is used to copy the status of locks on other PE's ! into a table that can be examined on the local process. @@ -56,8 +59,10 @@ function new_MpiMutex(comm) result(lock) integer :: displs(2) blklens = [lock%rank, lock%npes - lock%rank - 1] displs = [0, lock%rank + 1] - call MPI_Type_indexed(2, blklens, displs, MPI_LOGICAL, lock%pe_locks_type, _IERROR); - call MPI_Type_commit(lock%pe_locks_type, _IERROR) + call MPI_Type_indexed(2, blklens, displs, MPI_LOGICAL, lock%pe_locks_type, ierror); + _VERIFY(ierror) + call MPI_Type_commit(lock%pe_locks_type, ierror) + _VERIFY(ierror) end block ! Create windows @@ -67,12 +72,15 @@ function new_MpiMutex(comm) result(lock) logical, pointer :: scratchpad(:) integer :: sizeof_logical - call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, _IERROR) + call MPI_Type_extent(MPI_LOGICAL, sizeof_logical, ierror) + _VERIFY(ierror) sz = lock%npes * sizeof_logical #if defined(SUPPORT_FOR_MPI_ALLOC_MEM_CPTR) - call MPI_Alloc_mem(sz, MPI_INFO_NULL, lock%locks_ptr, _IERROR) + call MPI_Alloc_mem(sz, MPI_INFO_NULL, lock%locks_ptr, ierror) + _VERIFY(ierror) #else - call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, _IERROR) + call MPI_Alloc_mem(sz, MPI_INFO_NULL, baseaddr, ierror) + _VERIFY(ierror) lock%locks_ptr = transfer(baseaddr, lock%locks_ptr) #endif @@ -80,14 +88,16 @@ function new_MpiMutex(comm) result(lock) scratchpad = .false. call MPI_Win_create(scratchpad, sz, sizeof_logical, & - & MPI_INFO_NULL, lock%comm, lock%window, _IERROR) + & MPI_INFO_NULL, lock%comm, lock%window, ierror) + _VERIFY(ierror) end block else ! local window memory is size 0, but have to pass something block logical :: buffer(1) sz = 0 - call MPI_Win_create(buffer, sz, 1, MPI_INFO_NULL, lock%comm, lock%window, _IERROR) + call MPI_Win_create(buffer, sz, 1, MPI_INFO_NULL, lock%comm, lock%window, ierror) + _VERIFY(ierror) end block end if @@ -102,20 +112,25 @@ subroutine acquire(this) integer :: ierror,rc,status - call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, _IERROR) + call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + _VERIFY(ierror) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & - & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, _IERROR) + & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + _VERIFY(ierror) call MPI_Put(.true., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & - & 1, MPI_LOGICAL, this%window, _IERROR) + & 1, MPI_LOGICAL, this%window, ierror) + _VERIFY(ierror) - call MPI_Win_unlock(0, this%window, _IERROR) + call MPI_Win_unlock(0, this%window, ierror) + _VERIFY(ierror) ! Check other processes for holding the lock if (any(this%local_data)) then ! wait for signal from process with the lock block integer :: buffer ! unused call MPI_Recv(buffer, 0, MPI_LOGICAL, MPI_ANY_SOURCE, & - & LOCK_TAG, this%comm, MPI_STATUS_IGNORE, _IERROR) + & LOCK_TAG, this%comm, MPI_STATUS_IGNORE, ierror) + _VERIFY(ierror) end block end if @@ -128,12 +143,16 @@ subroutine release(this) integer :: ierror,rc,status - call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, _IERROR) + call MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, this%window, ierror) + _VERIFY(ierror) call MPI_Get(this%local_data, this%npes-1, MPI_LOGICAL, 0, & - & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, _IERROR) + & 0_MPI_ADDRESS_KIND, 1, this%pe_locks_type, this%window, ierror) + _VERIFY(ierror) call MPI_Put(.false., 1, MPI_LOGICAL, 0, int(this%rank,kind=MPI_ADDRESS_KIND), & - & 1, MPI_LOGICAL, this%window, _IERROR) - call MPI_Win_unlock(0, this%window, _IERROR) + & 1, MPI_LOGICAL, this%window, ierror) + _VERIFY(ierror) + call MPI_Win_unlock(0, this%window, ierror) + _VERIFY(ierror) ! who needs the lock next (if anyone)? block @@ -157,7 +176,8 @@ subroutine release(this) if (next_rank /= -1) then call MPI_Send(buffer, 0, MPI_LOGICAL, next_rank, & - & LOCK_TAG, this%comm, _IERROR) + & LOCK_TAG, this%comm, ierror) + _VERIFY(ierror) end if end block @@ -170,14 +190,18 @@ subroutine free_mpi_resources(this) integer :: ierror,rc,status ! Release resources - call MPI_Type_free(this%pe_locks_type, _IERROR) - call MPI_Win_free(this%window, _IERROR) + call MPI_Type_free(this%pe_locks_type, ierror) + _VERIFY(ierror) + call MPI_Win_free(this%window, ierror) + _VERIFY(ierror) if (this%rank == 0) then call c_f_pointer(this%locks_ptr, scratchpad, [this%npes]) - call MPI_Free_mem(scratchpad, _IERROR) + call MPI_Free_mem(scratchpad, ierror) + _VERIFY(ierror) end if - call Mpi_comm_free(this%comm, _IERROR) + call Mpi_comm_free(this%comm, ierror) + _VERIFY(ierror) end subroutine free_mpi_resources diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index d08d0a53a526..c4a56b80d2f1 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -89,7 +89,8 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul integer, allocatable :: node_sizes(:) s%server_comm = server_comm - call MPI_Comm_size(s%server_comm, s_size , _IERROR) + call MPI_Comm_size(s%server_comm, s_size , ierror) + _VERIFY(ierror) s%splitter = SimpleCommsplitter(s%server_comm) node_sizes = s%splitter%get_node_sizes() @@ -107,7 +108,8 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul allocate(s%back_ranks(nwriter)) allocate(s%front_ranks(s%nfront)) - call MPI_Comm_rank(s%server_comm, s_rank, _IERROR) + call MPI_Comm_rank(s%server_comm, s_rank, ierror) + _VERIFY(ierror) s_name = s_comm%get_name() s%I_am_front_root = .false. s%I_am_back_root = .false. @@ -115,36 +117,46 @@ function new_MultiCommServer(server_comm, port_name, nwriter_per_node, rc) resul s%front_comm = s_comm%get_subcommunicator() call s%init(s%front_comm, s_name) s%port_name = trim(port_name) - call MPI_Comm_rank(s%front_comm, local_rank, _IERROR) + call MPI_Comm_rank(s%front_comm, local_rank, ierror) + _VERIFY(ierror) if (s_rank == 0) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") s%I_am_front_root = .true. - call MPI_recv(s%back_ranks, nwriter, MPI_INTEGER, MPI_ANY_SOURCE, 666, s%server_comm, MPI_STAT,_IERROR) + call MPI_recv(s%back_ranks, nwriter, MPI_INTEGER, MPI_ANY_SOURCE, 666, s%server_comm, MPI_STAT,ierror) + _VERIFY(ierror) endif - call MPI_Bcast(s%back_ranks, nwriter, MPI_INTEGER, 0, s%front_comm, _IERROR) + call MPI_Bcast(s%back_ranks, nwriter, MPI_INTEGER, 0, s%front_comm, ierror) + _VERIFY(ierror) - call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%front_ranks, 1, MPI_INTEGER, s%front_comm, _IERROR) + call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%front_ranks, 1, MPI_INTEGER, s%front_comm, ierror) + _VERIFY(ierror) if (local_rank ==0 ) then - call MPI_Send(s%front_ranks, s_size-nwriter, MPI_INTEGER, s%back_ranks(1), 777, s%server_comm, _IERROR) + call MPI_Send(s%front_ranks, s_size-nwriter, MPI_INTEGER, s%back_ranks(1), 777, s%server_comm, ierror) + _VERIFY(ierror) endif endif if (index(s_name, 'o_server_back') /=0) then s%back_comm = s_comm%get_subcommunicator() - call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%back_ranks, 1, MPI_INTEGER, s%back_comm, _IERROR) - call MPI_Comm_rank(s%back_comm, local_rank, _IERROR) + call MPI_AllGather(s_rank, 1, MPI_INTEGER, s%back_ranks, 1, MPI_INTEGER, s%back_comm, ierror) + _VERIFY(ierror) + call MPI_Comm_rank(s%back_comm, local_rank, ierror) + _VERIFY(ierror) if (local_rank ==0 ) then s%I_am_back_root = .true. - call MPI_Send(s%back_ranks, nwriter, MPI_INTEGER, 0, 666, s%server_comm, _IERROR) + call MPI_Send(s%back_ranks, nwriter, MPI_INTEGER, 0, 666, s%server_comm, ierror) + _VERIFY(ierror) endif if (s_rank == s%back_ranks(1)) then _ASSERT( local_rank == 0, "re-arrange the rank of the server_comm") - call MPI_recv(s%front_ranks, s%nfront, MPI_INTEGER, MPI_ANY_SOURCE, 777, s%server_comm, MPI_STAT,_IERROR) + call MPI_recv(s%front_ranks, s%nfront, MPI_INTEGER, MPI_ANY_SOURCE, 777, s%server_comm, MPI_STAT,ierror) + _VERIFY(ierror) endif - call MPI_Bcast(s%front_ranks, s%nfront, MPI_INTEGER, 0, s%back_comm, _IERROR) + call MPI_Bcast(s%front_ranks, s%nfront, MPI_INTEGER, 0, s%back_comm, ierror) + _VERIFY(ierror) call s%set_status(1) call s%add_connection(dummy_socket) endif @@ -173,13 +185,15 @@ subroutine start_back(rc) integer :: ierr integer :: my_rank, cmd, status - call MPI_Comm_rank(this%server_comm, my_rank, _IERROR) + call MPI_Comm_rank(this%server_comm, my_rank, ierr) + _VERIFY(ierr) allocate(this%serverthread_done_msgs(1)) this%serverthread_done_msgs(:) = .false. do while (.true.) - call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) + call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) if (cmd == -1) exit call this%create_remote_win(_RC) call this%receive_output_data(_RC) @@ -227,7 +241,8 @@ subroutine start_front(rc) enddo call this%threads%clear() - call MPI_Bcast(terminate, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) + call MPI_Bcast(terminate, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) deallocate(mask) _RETURN(_SUCCESS) end subroutine start_front @@ -263,7 +278,8 @@ subroutine create_remote_win(this, rc) integer, allocatable :: buffer(:) if (this%front_comm /= MPI_COMM_NULL) then - call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, _IERROR) + call MPI_Bcast(cmd, 1, MPI_INTEGER, 0, this%server_comm, ierr) + _VERIFY(ierr) endif this%stage_offset = StringInteger64map() @@ -273,13 +289,16 @@ subroutine create_remote_win(this, rc) if (this%I_am_front_root) then call serialize_message_vector(thread_ptr%request_backlog,buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) - call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) + call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) + call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) call HistoryCollectionVector_serialize(thread_ptr%hist_collections, buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) - call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, _IERROR) + call MPI_send(bsize, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) + call MPI_send(buffer, bsize, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_Comm, ierr) + _VERIFY(ierr) endif @@ -287,30 +306,38 @@ subroutine create_remote_win(this, rc) if (this%I_am_back_root) then call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) endif - call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, _IERROR) + call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) if (.not. allocated(buffer)) allocate(buffer(bsize)) - call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, _IERROR) + call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) call deserialize_message_vector(buffer, thread_ptr%request_backlog) deallocate (buffer) if (this%I_am_back_root) then call MPI_recv( bsize, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer(bsize)) call MPI_recv( buffer,bsize, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) endif - call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, _IERROR) + call MPI_Bcast(bsize, 1, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) if (.not. allocated(buffer)) allocate(buffer(bsize)) - call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, _IERROR) + call MPI_Bcast(buffer, bsize, MPI_INTEGER, 0, this%back_comm, ierr) + _VERIFY(ierr) call HistoryCollectionVector_deserialize(buffer, thread_ptr%hist_collections) deallocate (buffer) endif @@ -393,7 +420,8 @@ subroutine put_DataToFile(this, rc) if (this%back_comm /= MPI_COMM_NULL) then - call MPI_comm_rank(this%back_comm, l_rank, _IERROR) + call MPI_comm_rank(this%back_comm, l_rank, ierr) + _VERIFY(ierr) ! copy and save the data do collection_counter = 1, this%dataRefPtrs%size() dataRefPtr => this%get_dataReference(collection_counter) @@ -463,7 +491,8 @@ subroutine clean_up(this, rc) if (this%back_Comm /= MPI_COMM_NULL) then ! time to write file - call MPI_comm_rank(this%back_comm, l_rank, _IERROR) + call MPI_comm_rank(this%back_comm, l_rank, ierr) + _VERIFY(ierr) threadPtr=>this%threads%at(1) msg_iter = threadPtr%request_backlog%begin() diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index 67e7f5b3afa3..0268f5c00ca9 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -386,12 +386,14 @@ subroutine receive_output_data(this, rc) ! root asks for idle writer and sends axtra file metadata if (this%I_am_front_root) then collection_id = collection_ids%at(collection_counter) - call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, _IERROR) + call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + _VERIFY(ierror) msg =>f_d_ms(collection_counter)%msg_vec%at(1) ! just pick first one. All messages should have the same filename select type (q=>msg) class is (AbstractCollectiveDataMessage) Filename = q%file_name - call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, _IERROR) + call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + _VERIFY(ierror) class default _FAIL( "yet to implemented") end select @@ -401,28 +403,37 @@ subroutine receive_output_data(this, rc) call hist_collection%fmd%serialize(buffer) endif - call Mpi_Bcast( collection_id, 1, MPI_INTEGER, 0, this%front_comm, _IERROR) + call Mpi_Bcast( collection_id, 1, MPI_INTEGER, 0, this%front_comm, ierror) + _VERIFY(ierror) if (associated(ioserver_profiler)) call ioserver_profiler%start("collection_"//i_to_string(collection_id)) if (this%I_am_front_root) then call Mpi_Recv(back_local_rank, 1, MPI_INTEGER, this%back_ranks(1), & - this%front_ranks(1), this%server_comm, MPI_STAT, _IERROR) + this%front_ranks(1), this%server_comm, MPI_STAT, ierror) + _VERIFY(ierror) msg_size= size(buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) + this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) call Mpi_send(buffer,msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) + this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) endif - call Mpi_Bcast( back_local_rank, 1, MPI_INTEGER, 0, this%front_comm, _IERROR) - if (allocated(this%buffers(back_local_rank+1)%buffer)) call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, _IERROR) + call Mpi_Bcast( back_local_rank, 1, MPI_INTEGER, 0, this%front_comm, ierror) + _VERIFY(ierror) + if (allocated(this%buffers(back_local_rank+1)%buffer)) then + call MPI_Wait(this%buffers(back_local_rank+1)%request, MPI_STAT, ierror) + _VERIFY(ierror) + endif call f_d_ms(collection_counter)%serialize(this%buffers(back_local_rank+1)%buffer) call f_d_ms(collection_counter)%destroy(_RC) msg_size= size(this%buffers(back_local_rank+1)%buffer) call Mpi_send(msg_size,1, MPI_INTEGER, this%back_ranks(back_local_rank+1), & - this%back_ranks(back_local_rank+1), this%server_comm, _IERROR) + this%back_ranks(back_local_rank+1), this%server_comm, ierror) + _VERIFY(ierror) call Mpi_Isend(this%buffers(back_local_rank+1)%buffer, msg_size, MPI_INTEGER, this%back_ranks(back_local_rank+1), & this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(back_local_rank+1)%request,ierror) if (associated(ioserver_profiler)) call ioserver_profiler%stop("collection_"//i_to_string(collection_id)) @@ -482,12 +493,14 @@ subroutine start_back_captain(rc) ! 1) captain node of back_comm is waiting command from front_comm call MPI_recv( collection_id, 1, MPI_INTEGER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) if (collection_id == -1) exit call MPI_recv( FileName, FNAME_LEN , MPI_CHARACTER, & this%front_ranks(1), this%back_ranks(1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) ! 2) get an idle processor and notify front root call dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc=status) _VERIFY(status) @@ -499,7 +512,8 @@ subroutine start_back_captain(rc) ! at the end , send done message to root of oserver ! this serves the syncronization with oserver terminate = -1 - call MPI_send(terminate, 1, MPI_INTEGER, 0, 0, this%server_comm, _IERROR) + call MPI_send(terminate, 1, MPI_INTEGER, 0, 0, this%server_comm, ierr) + _VERIFY(ierr) deallocate(num_idlePEs, idleRank) _RETURN(_SUCCESS) end subroutine start_back_captain @@ -527,11 +541,13 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) ! non block probe writers do local_rank = 1, this%nwriter-1 flag = .false. - call MPI_Iprobe( local_rank, stag, this%back_comm, flag, MPI_STAT, _IERROR) + call MPI_Iprobe( local_rank, stag, this%back_comm, flag, MPI_STAT, ierr) + _VERIFY(ierr) if (flag) then call MPI_recv(idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") node_rank = this%node_ranks(local_rank) num_idlePEs(node_rank) = num_idlePEs(node_rank) + 1 @@ -540,7 +556,8 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) call MPI_recv(FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) iter = FilesBeingWritten%find(FileDone) _ASSERT( iter /= FilesBeingWritten%end(), "FileDone should be in the set") @@ -570,10 +587,12 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) ! 2.2) tell front comm which idel_worker is ready call MPI_send(idle_writer, 1, MPI_INTEGER, this%front_ranks(1), & - this%front_ranks(1), this%server_comm, _IERROR) + this%front_ranks(1), this%server_comm, ierr) + _VERIFY(ierr) ! 2.3) forward the collection_id to the idle_writer - call MPI_send(collection_id, 1, MPI_INTEGER, idle_writer, idle_writer,this%back_comm, _IERROR) + call MPI_send(collection_id, 1, MPI_INTEGER, idle_writer, idle_writer,this%back_comm, ierr) + _VERIFY(ierr) _RETURN(_SUCCESS) end subroutine dispatch_work @@ -593,17 +612,21 @@ subroutine terminate_back_writers(idleRank, rc) if (idleRank(node_rank, nth_writer) >=1) then ! send no_job directly to terminate - call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, _IERROR) + call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + _VERIFY(ierr) else ! For busy worker, wait to receive idle_writer and the send no_job call MPI_recv( idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) call MPI_recv( FileDone, FNAME_LEN, MPI_CHARACTER, & local_rank, stag+1, this%back_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") - call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, _IERROR) + call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) + _VERIFY(ierr) endif enddo _RETURN(_SUCCESS) @@ -651,7 +674,8 @@ subroutine start_back_writers(rc) ! 1) get collection id from captain call MPI_recv( collection_id, 1, MPI_INTEGER, & 0, back_local_rank, this%back_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) if (collection_id == -1 ) exit ! exit when get terminate signal !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! sync with create_remote_win from front_com @@ -662,21 +686,25 @@ subroutine start_back_writers(rc) if (i == 1) then call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) allocate(buffer_fmd(msg_size)) call MPI_recv( buffer_fmd(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) endif call MPI_recv( msg_size, 1, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) if (allocated(this%buffers(i)%buffer)) deallocate (this%buffers(i)%buffer) allocate(this%buffers(i)%buffer(msg_size)) call MPI_Irecv( this%buffers(i)%buffer(1), msg_size, MPI_INTEGER, & this%front_ranks(i), this%back_ranks(back_local_rank+1), this%server_comm, this%buffers(i)%request, & - _IERROR) + ierr) + _VERIFY(ierr) enddo ! nfront ! re-org data @@ -687,7 +715,8 @@ subroutine start_back_writers(rc) do i = 1, this%nfront s0 = 1 f_d_m = ForwardDataAndMessage() - call MPI_Wait(this%buffers(i)%request, MPI_STAT, _IERROR) + call MPI_Wait(this%buffers(i)%request, MPI_STAT, ierr) + _VERIFY(ierr) call f_d_m%deserialize(this%buffers(i)%buffer) deallocate(this%buffers(i)%buffer) if (size(f_d_m%idata) ==0) cycle @@ -855,9 +884,11 @@ subroutine start_back_writers(rc) ! telling captain it is idle by sending its own rank !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , _IERROR) + call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , ierr) + _VERIFY(ierr) FileDone = Filename - call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , _IERROR) + call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , ierr) + _VERIFY(ierr) enddo _RETURN(_SUCCESS) end subroutine start_back_writers @@ -875,7 +906,7 @@ subroutine terminate_backend_server(this, rc) ! starting from 2, no backend root do i = 2, this%nwriter if (allocated(this%buffers(i)%buffer)) then - call MPI_Wait(this%buffers(i)%request, MPI_STAT, _IERROR) + call MPI_Wait(this%buffers(i)%request, MPI_STAT, ierr) _VERIFY(ierr) endif enddo @@ -884,10 +915,10 @@ subroutine terminate_backend_server(this, rc) ! The back root send terminate back for synchronization if (this%I_am_front_root) then call MPI_send(terminate, 1, MPI_INTEGER, this%back_ranks(1), & - this%back_ranks(1), this%server_comm, _IERROR) + this%back_ranks(1), this%server_comm, ierr) _VERIFY(ierr) call MPI_recv(terminate, 1, MPI_INTEGER, this%back_ranks(1), & - this%front_ranks(1), this%server_comm, MPI_STAT, _IERROR) + this%front_ranks(1), this%server_comm, MPI_STAT, ierr) _VERIFY(ierr) endif _RETURN(_SUCCESS) diff --git a/pfio/MultiLayerServer.F90 b/pfio/MultiLayerServer.F90 index 6d232f47ca96..9cd9da3763c0 100644 --- a/pfio/MultiLayerServer.F90 +++ b/pfio/MultiLayerServer.F90 @@ -125,8 +125,10 @@ subroutine terminate_writers(this) ! send terminate back for synchronization ! if no syncrohization, the writer may be still writing while the main testing node is comparing if( this%rank == 0 .and. this%nwriters > 1 ) then - call MPI_send(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, _IERROR) - call MPI_recv(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, MPI_STAT, _IERROR) + call MPI_send(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) + call MPI_recv(terminate, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, MPI_STAT, ierr) + _VERIFY(ierr) endif end subroutine terminate_writers @@ -217,7 +219,8 @@ subroutine put_DataToFile(this, rc) call forwardVec%clear() call forData%clear() endif - call MPI_Barrier(this%comm, _IERROR) + call MPI_Barrier(this%comm, status) + _VERIFY(status) endif ! first thread n==1 call threadPtr%clear_backlog() call threadPtr%clear_hist_collections() @@ -243,18 +246,24 @@ subroutine forward_DataToWriter(forwardVec, forwardData, rc) call serialize_message_vector(forwardVec,buffer) bsize = size(buffer) - call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) call MPI_recv(writer_rank, 1, MPI_INTEGER, & 0, pFIO_s_tag, this%Inter_Comm , & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) !forward Message - call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) - call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) + call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) !send number of collections call StringAttributeMap_serialize(forwardData,buffer) bsize = size(buffer) - call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) - call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, _IERROR) + call MPI_send(bsize, 1, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) + call MPI_send(buffer, bsize, MPI_INTEGER, writer_rank, pFIO_s_tag, this%Inter_Comm, ierr) + _VERIFY(ierr) !2) send the data _RETURN(_SUCCESS) diff --git a/pfio/pfio_base.F90 b/pfio/pfio_base.F90 index f52de98e5ce5..1abe7b53acf9 100644 --- a/pfio/pfio_base.F90 +++ b/pfio/pfio_base.F90 @@ -11,7 +11,8 @@ subroutine pfio_init() integer :: rank, ierror, rc, status if (debug_unit == 0) then - call MPI_Comm_rank(MPI_Comm_world, rank, _IERROR) + call MPI_Comm_rank(MPI_Comm_world, rank, ierror) + _VERIFY(ierror) write(buf,'(i5.5)') rank open(newunit=debug_unit,file='pfio_debug.'//buf,status='unknown', form='formatted') end if diff --git a/pfio/pfio_collective_demo.F90 b/pfio/pfio_collective_demo.F90 index 4eea79957438..efa79e9fd70d 100644 --- a/pfio/pfio_collective_demo.F90 +++ b/pfio/pfio_collective_demo.F90 @@ -323,9 +323,12 @@ program main type (FakeExtData), target :: extData required = MPI_THREAD_MULTIPLE - call MPI_init_thread(required, provided, _IERROR) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_init_thread(required, provided, ierror) + _VERIFY(ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) call process_command_line(options, rc=status) @@ -342,7 +345,8 @@ program main color = split_color(options%server_type,options%npes_server) key = 0 - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + _VERIFY(ierror) if (color == SERVER_COLOR .or. color == BOTH_COLOR) then ! server @@ -360,7 +364,7 @@ program main end if - call MPI_finalize(_IERROR) + call MPI_finalize(ierror) contains diff --git a/pfio/pfio_parallel_netcdf_reproducer.F90 b/pfio/pfio_parallel_netcdf_reproducer.F90 index 790c4cde0898..9e74b00228ae 100644 --- a/pfio/pfio_parallel_netcdf_reproducer.F90 +++ b/pfio/pfio_parallel_netcdf_reproducer.F90 @@ -14,7 +14,8 @@ program main integer :: n_fields character(:), allocatable :: output_filename - call MPI_Init(_IERROR) + call MPI_Init(ierror) + _VERIFY(ierror) call cli%init(description='potential reproducer of parallel netcdf problem on SCU12') call add_cli_options(cli) @@ -22,7 +23,7 @@ program main call run(im, lm, n_fields, output_filename) - call MPI_Finalize(_IERROR) + call MPI_Finalize(ierror) contains @@ -87,8 +88,10 @@ subroutine run(im, lm, n_fields, output_filename) character(:), allocatable :: field_name character(3) :: field_idx_str - call mpi_comm_size(MPI_COMM_WORLD, npes, _IERROR) - call mpi_comm_rank(MPI_COMM_WORLD, rank, _IERROR) + call mpi_comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) + call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) jm = im*6 ! pseudo cubed sphere call metadata%add_dimension('IM_WORLD', im) diff --git a/pfio/pfio_server_demo.F90 b/pfio/pfio_server_demo.F90 index 9c9a60e81e37..cdebf0d71bac 100644 --- a/pfio/pfio_server_demo.F90 +++ b/pfio/pfio_server_demo.F90 @@ -291,9 +291,12 @@ program main type (FakeExtData), target :: extData class(AbstractDirectoryService), pointer :: d_s=>null() - call MPI_init_thread(MPI_THREAD_MULTIPLE, provided, _IERROR) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_init_thread(MPI_THREAD_MULTIPLE, provided, ierror) + _VERIFY(ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) + call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + _VERIFY(ierror) call process_command_line(options, rc=status) @@ -305,7 +308,8 @@ program main end if key = 0 - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) + _VERIFY(ierror) !C$ num_threads = 20 allocate(d_s, source = DirectoryService(MPI_COMM_WORLD)) @@ -335,7 +339,7 @@ program main !call global_directory_service%terminate_servers(comm) end if - call MPI_finalize(_IERROR) + call MPI_finalize(ierror) end program main diff --git a/pfio/pfio_writer.F90 b/pfio/pfio_writer.F90 index 2b79e003e269..3836605869db 100644 --- a/pfio/pfio_writer.F90 +++ b/pfio/pfio_writer.F90 @@ -42,10 +42,14 @@ program main type (StringNetCDF4_FileFormatterMapIterator) :: iter class (AbstractMessage), pointer :: msg - call MPI_Init(_IERROR) - call MPI_Comm_get_parent(Inter_Comm, _IERROR); - call MPI_Comm_rank(MPI_COMM_WORLD,rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD,n_workers, _IERROR) + call MPI_Init(ierr) + _VERIFY(ierr) + call MPI_Comm_get_parent(Inter_Comm, ierr); + _VERIFY(ierr) + call MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) + _VERIFY(ierr) + call MPI_Comm_size(MPI_COMM_WORLD,n_workers, ierr) + _VERIFY(ierr) allocate(busy(n_workers-1), source =0) @@ -55,7 +59,8 @@ program main ! 1) captain node is waiting command from server call MPI_recv( command, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_s_tag, Inter_Comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) server_rank = MPI_STAT(MPI_SOURCE) if (command == 1) then ! server is asking for a writing node @@ -74,27 +79,33 @@ program main call MPI_recv( idle, 1, MPI_INTEGER, & MPI_ANY_SOURCE, pFIO_w_m_tag , MPI_COMM_WORLD, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) idle_worker = idle endif ! tell server the idel_worker - call MPI_send(idle_worker, 1, MPI_INTEGER, server_rank, pFIO_s_tag, Inter_Comm, _IERROR) + call MPI_send(idle_worker, 1, MPI_INTEGER, server_rank, pFIO_s_tag, Inter_Comm, ierr) + _VERIFY(ierr) busy(idle_worker) = 1 ! tell the idle_worker which server has work - call MPI_send(server_rank, 1, MPI_INTEGER, idle_worker, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) + call MPI_send(server_rank, 1, MPI_INTEGER, idle_worker, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) else ! command /=1, notify the worker to quit and finalize no_job = -1 do i = 1, n_workers -1 if ( busy(i) == 0) then - call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) + call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) else call MPI_recv( idle, 1, MPI_INTEGER, & i, pFIO_w_m_tag, MPI_COMM_WORLD, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) if (idle /= i ) stop ("idle should be i") - call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, _IERROR) + call MPI_send(no_job, 1, MPI_INTEGER, i, pFIO_m_w_tag, MPI_COMM_WORLD, ierr) + _VERIFY(ierr) endif enddo exit @@ -108,7 +119,8 @@ program main ! 1) get server_rank from captain call MPI_recv( server_rank, 1, MPI_INTEGER, & 0, pFIO_m_w_tag, MPI_COMM_WORLD, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) if (server_rank == -1 ) exit !--------------------------------------------------- @@ -116,20 +128,24 @@ program main !--------------------------------------------------- call MPI_recv( msg_size, 1, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) allocate(bufferm(msg_size)) call MPI_recv( bufferm, msg_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) call MPI_recv( data_size, 1, MPI_INTEGER,& server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) allocate(bufferd(data_size)) call MPI_recv( bufferd, data_size, MPI_INTEGER, & server_rank, pFIO_s_tag, Inter_comm, & - MPI_STAT, _IERROR) + MPI_STAT, ierr) + _VERIFY(ierr) ! deserilize message and data call deserialize_message_vector(bufferm, forwardVec) @@ -168,21 +184,24 @@ program main deallocate(bufferd, bufferm) ! telling captain, I am the soldier that is ready to have more work - call MPI_send(rank, 1, MPI_INTEGER, 0, pFIO_w_m_tag, MPI_COMM_WORLD , _IERROR) + call MPI_send(rank, 1, MPI_INTEGER, 0, pFIO_w_m_tag, MPI_COMM_WORLD , ierr) + _VERIFY(ierr) enddo endif - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, ierr) + _VERIFY(ierr) if ( rank == 0) then ! send done message to server ! this serves the syncronization with oserver command = -1 - call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, Inter_Comm, _IERROR) + call MPI_send(command, 1, MPI_INTEGER, 0, pFIO_s_tag, Inter_Comm, ierr) + _VERIFY(ierr) endif - call MPI_Finalize(_IERROR) + call MPI_Finalize(ierr) contains From ebcfaa991512567b88ae4c8e5f2e2002122660a4 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Mon, 22 Jul 2024 10:16:29 -0400 Subject: [PATCH 24/77] Remove _IERROR as argument but use instead _VERIFY(ierror) statements in the profiler folder. --- profiler/DistributedMeter.F90 | 30 ++++++++++++++++++++---------- profiler/VmstatMemoryGauge.F90 | 3 ++- profiler/demo/demo.F90 | 5 +++-- profiler/demo/mpi_demo.F90 | 14 +++++++++----- 4 files changed, 34 insertions(+), 18 deletions(-) diff --git a/profiler/DistributedMeter.F90 b/profiler/DistributedMeter.F90 index b7981338824c..770c42235eb7 100644 --- a/profiler/DistributedMeter.F90 +++ b/profiler/DistributedMeter.F90 @@ -145,10 +145,12 @@ subroutine initialize(ierror) integer :: rc, status call dummy%make_mpi_type(dummy%statistics, type_dist_struct, ierror) - call MPI_Type_commit(type_dist_struct, _IERROR) + call MPI_Type_commit(type_dist_struct, ierror) + _VERIFY(ierror) commute = .true. - call MPI_Op_create(true_reduce, commute, dist_reduce_op, _IERROR) + call MPI_Op_create(true_reduce, commute, dist_reduce_op, ierror) + _VERIFY(ierror) end subroutine initialize @@ -281,7 +283,8 @@ subroutine reduce_mpi(this, comm, exclusive) type(DistributedStatistics) :: tmp integer :: rc, status - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, ierror) + _VERIFY(ierror) this%statistics%total = DistributedReal64(this%get_total(), rank) this%statistics%exclusive = DistributedReal64(exclusive, rank) @@ -291,7 +294,8 @@ subroutine reduce_mpi(this, comm, exclusive) this%statistics%num_cycles = DistributedInteger(this%get_num_cycles(), rank) tmp = this%statistics - call MPI_Reduce(tmp, this%statistics, 1, type_dist_struct, dist_reduce_op, 0, comm, _IERROR) + call MPI_Reduce(tmp, this%statistics, 1, type_dist_struct, dist_reduce_op, 0, comm, ierror) + _VERIFY(ierror) end subroutine reduce_mpi @@ -308,10 +312,12 @@ subroutine make_mpi_type_distributed_real64(this, r64, new_type, ierror) _UNUSED_DUMMY(this) _UNUSED_DUMMY(r64) - call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, _IERROR) + call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, ierror) + _VERIFY(ierror) displacements = [0_MPI_ADDRESS_KIND, 3*sz] - call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, _IERROR) + call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_real64 @@ -328,7 +334,8 @@ subroutine make_mpi_type_distributed_integer(this, int, new_type, ierror) _UNUSED_DUMMY(this) _UNUSED_DUMMY(int) displacements = [0_MPI_ADDRESS_KIND] - call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, _IERROR) + call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_integer @@ -347,10 +354,13 @@ subroutine make_mpi_type_distributed_data(this, d, new_type, ierror) call this%make_mpi_type(this%statistics%total, type_dist_real64, ierror) call this%make_mpi_type(this%statistics%num_cycles, type_dist_integer, ierror) - call MPI_Type_get_extent_x(type_dist_real64, lb, sz, _IERROR) + call MPI_Type_get_extent_x(type_dist_real64, lb, sz, ierror) + _VERIFY(ierror) displacements = [0_MPI_ADDRESS_KIND, 6*sz] - call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, _IERROR) - call MPI_Type_get_extent_x(new_type, lb, sz2, _IERROR) + call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, ierror) + _VERIFY(ierror) + call MPI_Type_get_extent_x(new_type, lb, sz2, ierror) + _VERIFY(ierror) end subroutine make_mpi_type_distributed_data diff --git a/profiler/VmstatMemoryGauge.F90 b/profiler/VmstatMemoryGauge.F90 index 65ad7170b7f7..5fc0451de51d 100644 --- a/profiler/VmstatMemoryGauge.F90 +++ b/profiler/VmstatMemoryGauge.F90 @@ -43,7 +43,8 @@ function get_measurement(this) result(mem_use) block use MPI integer :: rank, ierror, status, rc - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) allocate(character(4) :: tmp_file) write(tmp_file,'(i4.4)')rank tmp_file = 'tmp_' // tmp_file // '.dat' diff --git a/profiler/demo/demo.F90 b/profiler/demo/demo.F90 index 66fb2b7351e4..91f7828f4f9f 100644 --- a/profiler/demo/demo.F90 +++ b/profiler/demo/demo.F90 @@ -17,7 +17,8 @@ program main integer :: i integer :: ierror, rc, status - call MPI_Init(_IERROR) + call MPI_Init(ierror) + _VERIFY(ierror) main_prof = TimeProfiler('TOTAL') ! timer 1 call main_prof%start() lap_prof = TimeProfiler('Lap') @@ -88,7 +89,7 @@ program main write(*,'(a)') '' - call MPI_Finalize(_IERROR) + call MPI_Finalize(ierror) !call mem_prof%finalize() !report_lines = mem_reporter%generate_report(mem_prof) diff --git a/profiler/demo/mpi_demo.F90 b/profiler/demo/mpi_demo.F90 index e6fad5513997..970cf75845d8 100644 --- a/profiler/demo/mpi_demo.F90 +++ b/profiler/demo/mpi_demo.F90 @@ -20,8 +20,10 @@ program main !$ mem_prof = MemoryProfiler('TOTAL') - call MPI_Init(_IERROR) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) + call MPI_Init(ierror) + _VERIFY(ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + _VERIFY(ierror) main_prof = DistributedProfiler('TOTAL', MpiTimerGauge(), MPI_COMM_WORLD) ! timer 1 call main_prof%start() @@ -111,7 +113,8 @@ program main end do write(*,'(a)') '' end if - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, ierror) + _VERIFY(ierror) if (rank == 1) then write(*,'(a)')'Final profile (1)' write(*,'(a)')'================' @@ -120,7 +123,8 @@ program main end do write(*,'(a)') '' end if - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, ierror) + _VERIFY(ierror) report_lines = main_reporter%generate_report(main_prof) if (rank == 0) then @@ -143,7 +147,7 @@ program main !$ write(*,'(a)') '' !$ end if - call MPI_Finalize(_IERROR) + call MPI_Finalize(ierror) contains From c6faca717b40d06cae5251714cf779bec1138fb4 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Mon, 22 Jul 2024 10:36:20 -0400 Subject: [PATCH 25/77] Remove _IERROR as argument but use instead _VERIFY(ierror) statements in the base folder. --- base/FileIOShared.F90 | 57 ++++++++++++++++++++++++++++--------------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/base/FileIOShared.F90 b/base/FileIOShared.F90 index 3b0d4ed75bd7..3854e48ddbdb 100644 --- a/base/FileIOShared.F90 +++ b/base/FileIOShared.F90 @@ -431,8 +431,10 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers integer :: status - call MPI_Comm_Rank(comm,myid,_IERROR) - call MPI_COMM_Size(comm,npes,_IERROR) + call MPI_Comm_Rank(comm,myid,status) + _VERIFY(status) + call MPI_COMM_Size(comm,npes,status) + _VERIFY(status) allocate(iminw(npes),imaxw(npes),jminw(npes),jmaxw(npes),stat=status) iminw=-1 @@ -489,9 +491,11 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers NX0 = mod(myid,nx) + 1 NY0 = myid/nx + 1 color = nx0 - call MPI_Comm_Split(comm,color,myid,ycomm,_IERROR) + call MPI_Comm_Split(comm,color,myid,ycomm,status) + _VERIFY(status) color = ny0 - call MPI_Comm_Split(comm,color,myid,xcomm,_IERROR) + call MPI_Comm_Split(comm,color,myid,xcomm,status) + _VERIFY(status) ! reader communicators if (num_readers > ny .or. mod(ny,num_readers) /= 0) then _RETURN(ESMF_FAILURE) @@ -502,12 +506,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(comm,color,myid,readers_comm,_IERROR) + call MPI_COMM_SPLIT(comm,color,myid,readers_comm,status) + _VERIFY(status) if (num_readers==ny) then IOscattercomm = xcomm else j = ny0 - mod(ny0-1,ny_by_readers) - call MPI_Comm_Split(comm,j,myid,IOScattercomm,_IERROR) + call MPI_Comm_Split(comm,j,myid,IOScattercomm,status) + _VERIFY(status) endif ! writer communicators if (num_writers > ny .or. mod(ny,num_writers) /= 0) then @@ -519,12 +525,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(comm,color,myid,writers_comm,_IERROR) + call MPI_COMM_SPLIT(comm,color,myid,writers_comm,status) + _VERIFY(status) if (num_writers==ny) then IOgathercomm = xcomm else j = ny0 - mod(ny0-1,ny_by_writers) - call MPI_Comm_Split(comm,j,myid,IOgathercomm,_IERROR) + call MPI_Comm_Split(comm,j,myid,IOgathercomm,status) + _VERIFY(status) endif ArrDes%im_world=im_world @@ -537,7 +545,8 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers ArrDes%iogathercomm = iogathercomm ArrDes%xcomm = xcomm ArrDes%ycomm = ycomm - call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,_IERROR) + call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,status) + _VERIFY(status) allocate(arrdes%i1(size(i1)),_STAT) arrdes%i1=i1 @@ -605,23 +614,28 @@ subroutine ArrDescrCreateWriterComm(arrdes, full_comm, num_writers, rc) ny = size(arrdes%j1) _ASSERT(num_writers <= ny,'num writers must be less or equal to than NY') _ASSERT(mod(ny,num_writers)==0,'num writerss must evenly divide NY') - call mpi_comm_rank(full_comm,myid, _IERROR) + call mpi_comm_rank(full_comm,myid, status) + _VERIFY(status) color = arrdes%NX0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status) + _VERIFY(status) color = arrdes%NY0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status) + _VERIFY(status) ny_by_writers = ny/num_writers if (mod(myid,nx*ny/num_writers) == 0) then color = 0 else color = MPI_UNDEFINED endif - call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, status) + _VERIFY(status) if (num_writers==ny) then arrdes%IOgathercomm = arrdes%Xcomm else j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_writers) - call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, status) + _VERIFY(status) endif if (arrdes%writers_comm /= MPI_COMM_NULL) then call mpi_comm_rank(arrdes%writers_comm,writer_rank,status) @@ -648,23 +662,28 @@ subroutine ArrDescrCreateReaderComm(arrdes, full_comm, num_readers, rc) _ASSERT(num_readers <= ny,'num readers must be less than or equal to NY') _ASSERT(mod(ny,num_readers)==0,'num readers must evenly divide NY') - call mpi_comm_rank(full_comm,myid, _IERROR) + call mpi_comm_rank(full_comm,myid, status) + _VERIFY(status) color = arrdes%NX0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status) + _VERIFY(status) color = arrdes%NY0 - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status) + _VERIFY(status) ny_by_readers = ny/num_readers if (mod(myid,nx*ny/num_readers) == 0) then color = 0 else color = MPI_UNDEFINED endif - call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, _IERROR) + call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, status) + _VERIFY(status) if (num_readers==ny) then arrdes%IOscattercomm = arrdes%Xcomm else j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_readers) - call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, _IERROR) + call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, status) + _VERIFY(status) endif _RETURN(_SUCCESS) From fa87207699b4ee5e610afe0400523f27b4537a2b Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Mon, 22 Jul 2024 11:30:54 -0400 Subject: [PATCH 26/77] Remove _IERROR as argument but use instead _VERIFY(ierror) statements in the benchmarks folder. --- .../checkpoint_simulator.F90 | 153 ++++++++++++------ benchmarks/io/combo/GathervKernel.F90 | 6 +- benchmarks/io/combo/driver.F90 | 38 +++-- benchmarks/io/gatherv/GathervKernel.F90 | 6 +- benchmarks/io/gatherv/GathervSpec.F90 | 3 +- benchmarks/io/gatherv/driver.F90 | 38 +++-- benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 | 3 +- benchmarks/io/raw_bw/driver.F90 | 41 +++-- 8 files changed, 192 insertions(+), 96 deletions(-) diff --git a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 index 77cc71ae7a6f..96bad4dfd6a5 100644 --- a/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 +++ b/benchmarks/io/checkpoint_simulator/checkpoint_simulator.F90 @@ -97,9 +97,11 @@ subroutine set_parameters(this,config_file) this%data_volume = 0.d0 this%time_writing = 0.d0 this%mpi_time = 0.0 - call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,_IERROR) + call MPI_COMM_SIZE(MPI_COMM_WORLD,comm_size,status) + _VERIFY(status) if (comm_size /= (this%nx*this%ny*6)) then - call MPI_Abort(mpi_comm_world,error_code,_IERROR) + call MPI_Abort(mpi_comm_world,error_code,status) + _VERIFY(status) endif contains @@ -181,7 +183,8 @@ subroutine allocate_n_arrays(this,im,jm) integer :: seed_size integer, allocatable :: seeds(:) - call MPI_COMM_RANK(MPI_COMM_WORLD,rank,_IERROR) + call MPI_COMM_RANK(MPI_COMM_WORLD,rank,status) + _VERIFY(status) call random_seed(size=seed_size) allocate(seeds(seed_size)) seeds = rank @@ -204,8 +207,10 @@ subroutine create_arrays(this) integer, allocatable :: ims(:),jms(:) integer :: rank, status,comm_size,n,i,j,rank_counter,offset,index_offset,rc - call MPI_Comm_Rank(MPI_COMM_WORLD,rank,_IERROR) - call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,_IERROR) + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + _VERIFY(status) + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + _VERIFY(status) allocate(this%bundle(this%num_arrays)) ims = this%compute_decomposition(axis=1) jms = this%compute_decomposition(axis=2) @@ -257,13 +262,16 @@ subroutine create_communicators(this) integer :: myid,status,nx0,ny0,color,j,ny_by_writers,local_ny,key,rc local_ny = this%ny*6 - call MPI_Comm_Rank(mpi_comm_world,myid,_IERROR) + call MPI_Comm_Rank(mpi_comm_world,myid,status) + _VERIFY(status) nx0 = mod(myid,this%nx) + 1 ny0 = myid/this%nx + 1 color = nx0 - call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,_IERROR) + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,status) + _VERIFY(status) color = ny0 - call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,_IERROR) + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,status) + _VERIFY(status) ny_by_writers = local_ny/this%num_writers @@ -272,16 +280,19 @@ subroutine create_communicators(this) else color = MPI_UNDEFINED end if - call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%writers_comm,_IERROR) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%writers_comm,status) + _VERIFY(status) if (this%num_writers == local_ny) then this%gather_comm = this%xcomm else j = ny0 - mod(ny0-1,ny_by_writers) - call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm, _IERROR) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%gather_comm, status) + _VERIFY(status) end if - call MPI_BARRIER(mpi_comm_world, _IERROR) + call MPI_BARRIER(mpi_comm_world, status) + _VERIFY(status) end subroutine @@ -302,7 +313,8 @@ subroutine close_file(this) close(this%ncid) end if end if - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) this%close_file_time = sub_end-sub_start end subroutine @@ -325,16 +337,22 @@ subroutine create_file(this) create_mode = IOR(create_mode,NF90_NETCDF4) create_mode = IOR(create_mode,NF90_SHARE) create_mode = IOR(create_mode,NF90_MPIIO) - call MPI_INFO_CREATE(info, _IERROR) - call MPI_INFO_SET(info,"cb_buffer_size","16777216", _IERROR) - call MPI_INFO_SET(info,"romio_cb_write","enable", _IERROR) + call MPI_INFO_CREATE(info, status) + _VERIFY(status) + call MPI_INFO_SET(info,"cb_buffer_size","16777216", status) + _VERIFY(status) + call MPI_INFO_SET(info,"romio_cb_write","enable", status) + _VERIFY(status) if (this%extra_info) then - call MPI_INFO_SET(info,"IBM_largeblock_io","true", _IERROR) - call MPI_INFO_SET(info,"striping_unit","4194304", _IERROR) + call MPI_INFO_SET(info,"IBM_largeblock_io","true", status) + _VERIFY(status) + call MPI_INFO_SET(info,"striping_unit","4194304", status) + _VERIFY(status) end if if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank, _IERROR) + call MPI_COMM_RANK(this%writers_comm,writer_rank, status) + _VERIFY(status) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".nc4" status = nf90_create(fname,ior(NF90_NETCDF4,NF90_CLOBBER), this%ncid) @@ -371,14 +389,16 @@ subroutine create_file(this) else if (this%writers_comm /= MPI_COMM_NULL) then if (this%split_file) then - call MPI_COMM_RANK(this%writers_comm,writer_rank, _IERROR) + call MPI_COMM_RANK(this%writers_comm,writer_rank, status) + _VERIFY(status) write(fc,'(I0.3)')writer_rank fname = "checkpoint_"//fc//".bin" open(file=fname,newunit=this%ncid,status='replace',form='unformatted',access='sequential') end if end if end if - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) this%create_file_time = sub_end-sub_start end subroutine @@ -390,9 +410,11 @@ subroutine write_file(this) integer(kind=INT64) :: sub_start,sub_end - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_start) - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) do i=1,this%num_arrays if (this%gather_3d) then call this%write_variable(this%bundle(i)%field_name,this%bundle(i)%field) @@ -402,11 +424,14 @@ subroutine write_file(this) enddo end if enddo - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=sub_end) - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) this%write_3d_time = sub_end-sub_start - call MPI_BARRIER(MPI_COMM_WORLD, _IERROR) + call MPI_BARRIER(MPI_COMM_WORLD, status) + _VERIFY(status) end subroutine subroutine write_variable(this,var_name,local_var) @@ -430,9 +455,12 @@ subroutine write_variable(this,var_name,local_var) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow, _IERROR) - call mpi_comm_rank(this%gather_comm,myiorank, _IERROR) - call mpi_comm_size(this%gather_comm,num_io_rows, _IERROR) + call mpi_comm_rank(this%ycomm,myrow, status) + _VERIFY(status) + call mpi_comm_rank(this%gather_comm,myiorank, status) + _VERIFY(status) + call mpi_comm_size(this%gather_comm,num_io_rows, status) + _VERIFY(status) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -464,7 +492,10 @@ subroutine write_variable(this,var_name,local_var) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%time_mpi = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + if (this%write_barrier) then + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + endif if(myiorank==0) then @@ -543,9 +574,12 @@ subroutine write_level(this,var_name,local_var,z_index) jm_world = this%im_world*6 ndes_x = size(this%in) - call mpi_comm_rank(this%ycomm,myrow, _IERROR) - call mpi_comm_rank(this%gather_comm,myiorank, _IERROR) - call mpi_comm_size(this%gather_comm,num_io_rows, _IERROR) + call mpi_comm_rank(this%ycomm,myrow, status) + _VERIFY(status) + call mpi_comm_rank(this%gather_comm,myiorank, status) + _VERIFY(status) + call mpi_comm_size(this%gather_comm,num_io_rows, status) + _VERIFY(status) num_io_rows=num_io_rows/ndes_x allocate (recvcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) @@ -577,7 +611,10 @@ subroutine write_level(this,var_name,local_var,z_index) 0, this%gather_comm, status ) call system_clock(count=end_mpi) this%mpi_time = this%mpi_time + (end_mpi - start_mpi) - if (this%write_barrier) call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + if (this%write_barrier) then + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + endif if(myiorank==0) then @@ -656,22 +693,30 @@ program checkpoint_tester real(kind=REAL64) :: std_throughput, std_fs_throughput call system_clock(count=start_app,count_rate=count_rate) - call MPI_Init(_IERROR) - call MPI_Barrier(MPI_COMM_WORLD,_IERROR) - - call MPI_Comm_Rank(MPI_COMM_WORLD,rank,_IERROR) - call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,_IERROR) + call MPI_Init(status) + _VERIFY(status) + call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) + + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + _VERIFY(status) + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + _VERIFY(status) call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD) - call MPI_Barrier(MPI_COMM_WORLD,_IERROR) + call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%set_parameters("checkpoint_benchmark.rc") - call MPI_Barrier(MPI_COMM_WORLD,_IERROR) + call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%create_arrays() - call MPI_Barrier(MPI_COMM_WORLD,_IERROR) + call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) call support%create_communicators() - call MPI_Barrier(MPI_COMM_WORLD,_IERROR) + call MPI_Barrier(MPI_COMM_WORLD,status) + _VERIFY(status) allocate(total_throughput(support%n_trials)) allocate(all_proc_throughput(support%n_trials)) @@ -680,15 +725,19 @@ program checkpoint_tester call support%reset() call system_clock(count=start_write) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) if (support%do_writes) call support%create_file() - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) call support%write_file() - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) if (support%do_writes) call support%close_file() - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) call system_clock(count=end_time) write_time = real(end_time-start_write,kind=REAL64)/real(count_rate,kind=REAL64) @@ -699,11 +748,15 @@ program checkpoint_tester application_time = real(end_time - start_app,kind=REAL64)/real(count_rate,kind=REAL64) if (support%write_counter > 0) then - call MPI_COMM_SIZE(support%writers_comm,writer_size, _IERROR) - call MPI_COMM_RANK(support%writers_comm,writer_rank, _IERROR) - call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, _IERROR) + call MPI_COMM_SIZE(support%writers_comm,writer_size, status) + _VERIFY(status) + call MPI_COMM_RANK(support%writers_comm,writer_rank, status) + _VERIFY(status) + call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, status) + _VERIFY(status) average_volume = average_volume/real(writer_size,kind=REAL64) - call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, _IERROR) + call MPI_AllReduce(support%time_writing,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%writers_comm, status) + _VERIFY(status) average_time = average_time/real(writer_size,kind=REAL64) end if if (rank == 0) then diff --git a/benchmarks/io/combo/GathervKernel.F90 b/benchmarks/io/combo/GathervKernel.F90 index 6ea74a11b6f8..4d2d358f9c51 100644 --- a/benchmarks/io/combo/GathervKernel.F90 +++ b/benchmarks/io/combo/GathervKernel.F90 @@ -48,8 +48,10 @@ subroutine init(this, rc) - call MPI_Comm_rank(this%comm, this%rank, _IERROR) - call MPI_Comm_size(this%comm, this%np, _IERROR) + call MPI_Comm_rank(this%comm, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm, this%np, status) + _VERIFY(status) associate (np => this%np, n => this%n) allocate(this%buffer(this%n)) diff --git a/benchmarks/io/combo/driver.F90 b/benchmarks/io/combo/driver.F90 index 4ea28ed24704..329ddbe0a146 100644 --- a/benchmarks/io/combo/driver.F90 +++ b/benchmarks/io/combo/driver.F90 @@ -12,13 +12,15 @@ program main type(ComboSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_ComboSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -47,14 +49,19 @@ subroutine run(spec, rc) real :: ta, tb integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) if (rank /= 0) then writer_comm = MPI_COMM_NULL end if @@ -99,10 +106,12 @@ real function time(kernel, comm, rc) integer :: status real :: t0, t1 - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t0 = MPI_Wtime() call kernel%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t1 = MPI_Wtime() time = t1 - t0 @@ -117,7 +126,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(4(a6,","),4(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'G Time (s)', 'W Time (s)', 'BW (GB/sec)' @@ -142,10 +152,12 @@ subroutine report(spec, avg_time, avg_time_gather, avg_time_write, comm, rc) real :: bw_gb integer, parameter :: WORD=4 - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) group = npes /spec%n_writers bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time diff --git a/benchmarks/io/gatherv/GathervKernel.F90 b/benchmarks/io/gatherv/GathervKernel.F90 index d2e14c79293c..5a367ae1e177 100644 --- a/benchmarks/io/gatherv/GathervKernel.F90 +++ b/benchmarks/io/gatherv/GathervKernel.F90 @@ -47,8 +47,10 @@ subroutine init(this, rc) - call MPI_Comm_rank(this%comm, this%rank, _IERROR) - call MPI_Comm_size(this%comm, this%np, _IERROR) + call MPI_Comm_rank(this%comm, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm, this%np, status) + _VERIFY(status) associate (np => this%np, n => this%n) allocate(this%buffer(this%n)) diff --git a/benchmarks/io/gatherv/GathervSpec.F90 b/benchmarks/io/gatherv/GathervSpec.F90 index 1841800f9b3b..5ddc8badebbe 100644 --- a/benchmarks/io/gatherv/GathervSpec.F90 +++ b/benchmarks/io/gatherv/GathervSpec.F90 @@ -95,7 +95,8 @@ function make_GathervKernel(spec, comm, rc) result(kernel) integer :: npes integer :: n - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) n = int(spec%nx,kind=INT64)**2 * 6 * spec%n_levs / npes kernel = GathervKernel(n, comm) diff --git a/benchmarks/io/gatherv/driver.F90 b/benchmarks/io/gatherv/driver.F90 index 743da8ea316a..505860369119 100644 --- a/benchmarks/io/gatherv/driver.F90 +++ b/benchmarks/io/gatherv/driver.F90 @@ -10,13 +10,15 @@ program main type(GathervSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_GathervSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -42,14 +44,19 @@ subroutine run(spec, rc) real :: t integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) kernel = make_GathervKernel(spec, gather_comm, _RC) @@ -85,10 +92,12 @@ real function time(kernel, comm, rc) integer :: status real :: t0, t1 - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t0 = MPI_Wtime() call kernel%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) t1 = MPI_Wtime() time = t1 - t0 @@ -103,7 +112,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(4(a6,","),3(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'Rel. Std. dev.', 'BW (GB/sec)' @@ -126,10 +136,12 @@ subroutine report(spec, avg_time, rel_std_time, comm, rc) real :: bw_gb integer, parameter :: WORD=4 - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) group = npes /spec%n_writers bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time diff --git a/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 b/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 index a956e77f521b..6e8f2ede0cc0 100644 --- a/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 +++ b/benchmarks/io/raw_bw/BW_BenchmarkSpec.F90 @@ -99,7 +99,8 @@ function make_BW_Benchmark(spec, comm, rc) result(benchmark) call random_number(benchmark%buffer) end associate - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) benchmark%filename = make_filename(base='scratch.', rank=rank, width=5, _RC) _RETURN(_SUCCESS) diff --git a/benchmarks/io/raw_bw/driver.F90 b/benchmarks/io/raw_bw/driver.F90 index 1af1aaa68867..804683316599 100644 --- a/benchmarks/io/raw_bw/driver.F90 +++ b/benchmarks/io/raw_bw/driver.F90 @@ -11,13 +11,15 @@ program main type(BW_BenchmarkSpec) :: spec integer :: status - call mpi_init(_IERROR) + call mpi_init(status) + _VERIFY(status) spec = make_BW_BenchmarkSpec() ! CLI call run(spec, _RC) - call MPI_Barrier(MPI_COMM_WORLD, _IERROR) - call mpi_finalize(_IERROR) + call MPI_Barrier(MPI_COMM_WORLD, status) + _VERIFY(status) + call mpi_finalize(status) stop @@ -43,14 +45,19 @@ subroutine run(spec, rc) real :: t integer :: color, rank, npes - call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR) - call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, status) + _VERIFY(status) + call MPI_Comm_size(MPI_COMM_WORLD, npes, status) + _VERIFY(status) color = (rank*spec%n_writers) / npes - call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR) + call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status) + _VERIFY(status) - call MPI_Comm_rank(gather_comm, rank, _IERROR) - call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR) + call MPI_Comm_rank(gather_comm, rank, status) + _VERIFY(status) + call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status) + _VERIFY(status) if (rank /= 0) writer_comm = MPI_COMM_NULL _RETURN_IF(writer_comm == MPI_COMM_NULL) @@ -89,11 +96,13 @@ real function time(benchmark, comm, rc) integer :: rank integer(kind=INT64) :: c0, c1, count_rate - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) call system_clock(c0) call benchmark%run(_RC) - call MPI_Barrier(comm, _IERROR) + call MPI_Barrier(comm, status) + _VERIFY(status) call system_clock(c1, count_rate=count_rate) time = real(c1-c0)/count_rate @@ -109,7 +118,8 @@ subroutine write_header(comm, rc) integer :: status integer :: rank - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) write(*,'(3(a10,","),6(a15,:,","))',iostat=status) & @@ -136,8 +146,10 @@ subroutine report(spec, avg_time, std_time, comm, rc) integer, parameter :: WORD_SIZE = 4 integer(kind=INT64) :: packet_size - call MPI_Comm_size(comm, npes, _IERROR) - call MPI_Comm_rank(comm, rank, _IERROR) + call MPI_Comm_size(comm, npes, status) + _VERIFY(status) + call MPI_Comm_rank(comm, rank, status) + _VERIFY(status) _RETURN_UNLESS(rank == 0) packet_size = int(spec%nx,kind=INT64)**2 * 6 * spec%n_levs / spec%n_writers @@ -145,7 +157,8 @@ subroutine report(spec, avg_time, std_time, comm, rc) total_gb = packet_gb * npes bw = total_gb / avg_time - call MPI_Comm_size(comm, npes, _IERROR) + call MPI_Comm_size(comm, npes, status) + _VERIFY(status) write(*,'(3(1x,i9.0,","),6(f15.4,:,","))') & spec%nx, spec%n_levs, spec%n_writers, & From d23461b51d0abc6fb49774fd442c318a35e8bb20 Mon Sep 17 00:00:00 2001 From: Jules Kouatchou Date: Mon, 22 Jul 2024 11:51:50 -0400 Subject: [PATCH 27/77] Remove _IERROR as argument but use instead _VERIFY(ierror) statements in the gridcomps folder. --- gridcomps/Cap/MAPL_Cap.F90 | 22 +++++++++----- gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 | 5 ++-- .../Sampler/MAPL_GeosatMaskMod_smod.F90 | 30 ++++++++++++------- 3 files changed, 37 insertions(+), 20 deletions(-) diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 91f5e259ac58..33f771b43e84 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -285,12 +285,14 @@ subroutine run_model(this, comm, unusable, rc) ! Look for a file called "ESMF.rc" but we want to do this on root and then ! broadcast the result to the other ranks - call MPI_COMM_RANK(comm, rank, _IERROR) + call MPI_COMM_RANK(comm, rank, status) + _VERIFY(status) if (rank == 0) then inquire(file='ESMF.rc', exist=file_exists) end if - call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, _IERROR) + call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, status) + _VERIFY(status) ! If the file exists, we pass it into ESMF_Initialize, else, we ! use the one from the command line arguments @@ -348,7 +350,8 @@ subroutine report_throughput(rc) integer :: rank, ierror real(kind=REAL64) :: model_duration, wall_time, model_days_per_day - call MPI_Comm_rank(this%comm_world, rank, _IERROR) + call MPI_Comm_rank(this%comm_world, rank, ierror) + _VERIFY(ierror) if (rank == 0) then model_duration = this%cap_gc%get_model_duration() @@ -451,14 +454,17 @@ subroutine initialize_mpi(this, unusable, rc) call ESMF_InitializePreMPI(_RC) if (.not. this%mpi_already_initialized) then - call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, _IERROR) + call MPI_Init_thread(MPI_THREAD_MULTIPLE, provided, status) + _VERIFY(status) _ASSERT(provided == MPI_THREAD_MULTIPLE, 'MPI_THREAD_MULTIPLE not supported by this MPI.') -! call MPI_Init_thread(MPI_THREAD_SINGLE, provided, _IERROR) +! call MPI_Init_thread(MPI_THREAD_SINGLE, provided, status) ! _ASSERT(provided == MPI_THREAD_SINGLE, "MPI_THREAD_SINGLE not supported by this MPI.") end if - call MPI_Comm_rank(this%comm_world, this%rank, _IERROR) - call MPI_Comm_size(this%comm_world, npes_world, _IERROR) + call MPI_Comm_rank(this%comm_world, this%rank, status) + _VERIFY(status) + call MPI_Comm_size(this%comm_world, npes_world, status) + _VERIFY(status) if ( this%cap_options%npes_model == -1) then ! just a feed back to cap_options to maintain integrity @@ -497,7 +503,7 @@ subroutine finalize_mpi(this, unusable, rc) call MAPL_Finalize(comm=this%comm_world) if (.not. this%mpi_already_initialized) then - call MPI_Finalize(_IERROR) + call MPI_Finalize(status) end if _RETURN(_SUCCESS) diff --git a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 index 5ea428c898d9..7fdd7d8c9a71 100644 --- a/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 +++ b/gridcomps/Cap/MAPL_NUOPCWrapperMod.F90 @@ -147,7 +147,7 @@ subroutine initialize_p0(model, import_state, export_state, clock, rc) mpiCommunicator=mpi_comm, rc=status) _VERIFY(status) - !call MPI_Comm_dup(mpi_comm, dup_comm, _IERROR) + !call MPI_Comm_dup(mpi_comm, dup_comm, status) dup_comm = mpi_comm cap_params = get_cap_parameters_from_gc(model, status) @@ -159,7 +159,8 @@ subroutine initialize_p0(model, import_state, export_state, clock, rc) cap_options%comm = dup_comm ! cap_options%logging_config = "logging.yaml" cap_options%logging_config = '' - call MPI_Comm_size(dup_comm, cap_options%npes_model, _IERROR) + call MPI_Comm_size(dup_comm, cap_options%npes_model, status) + _VERIFY(status) allocate(cap) cap = MAPL_Cap(cap_params%name, cap_params%set_services, & diff --git a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 index beceb000b4bd..8461b9060a87 100644 --- a/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_GeosatMaskMod_smod.F90 @@ -340,7 +340,8 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end do call MPI_gatherv ( nx2, 1, MPI_INTEGER, & this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) if (.not. mapl_am_i_root()) then this%recvcounts(:) = 0 end if @@ -352,10 +353,12 @@ module subroutine create_Geosat_grid_find_mask(this, rc) nsend = nx2 call MPI_gatherv ( lons_chunk, nsend, MPI_REAL8, & lons, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) call MPI_gatherv ( lats_chunk, nsend, MPI_REAL8, & lats, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) !! if (mapl_am_I_root()) write(6,*) 'nobs tot :', nx @@ -389,12 +392,14 @@ module subroutine create_Geosat_grid_find_mask(this, rc) ptA(:) = lons_chunk(:) call ESMF_FieldRedistStore (fieldA, fieldB, RH, _RC) - call MPI_Barrier(mpic,_IERROR) + call MPI_Barrier(mpic,ierr) + _VERIFY(ierr) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lons_ds = ptB ptA(:) = lats_chunk(:) - call MPI_Barrier(mpic,_IERROR) + call MPI_Barrier(mpic,ierr) + _VERIFY(ierr) call ESMF_FieldRedist (fieldA, fieldB, RH, _RC) lats_ds = ptB @@ -522,7 +527,8 @@ module subroutine create_Geosat_grid_find_mask(this, rc) end do call MPI_gatherv ( this%npt_mask, 1, MPI_INTEGER, & this%recvcounts, recvcounts_loc, displs_loc, MPI_INTEGER,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) if (.not. mapl_am_i_root()) then this%recvcounts(:) = 0 end if @@ -537,10 +543,12 @@ module subroutine create_Geosat_grid_find_mask(this, rc) nsend=this%npt_mask call MPI_gatherv ( lons, nsend, MPI_REAL8, & this%lons, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) call MPI_gatherv ( lats, nsend, MPI_REAL8, & this%lats, this%recvcounts, this%displs, MPI_REAL8,& - iroot, mpic, _IERROR ) + iroot, mpic, ierr ) + _VERIFY(ierr) call MAPL_TimerOff(this%GENSTATE,"4_gatherV") @@ -728,7 +736,8 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx call MPI_gatherv ( p_dst_2d, nsend, MPI_REAL, & p_dst_2d_full, this%recvcounts, this%displs, MPI_REAL,& - iroot, mpic, _IERROR ) + iroot, mpic, status ) + _VERIFY(status) call MAPL_TimerOn(this%GENSTATE,"put2D") if (mapl_am_i_root()) then call this%formatter%put_var(item%xname,p_dst_2d_full,& @@ -752,7 +761,8 @@ module subroutine regrid_append_file(this,current_time,rc) nsend = nx * nz call MPI_gatherv ( p_dst_3d, nsend, MPI_REAL, & p_dst_3d_full, recvcounts_3d, displs_3d, MPI_REAL,& - iroot, mpic, _IERROR ) + iroot, mpic, status ) + _VERIFY(status) call MAPL_TimerOn(this%GENSTATE,"put3D") if (mapl_am_i_root()) then allocate(arr(nz, this%npt_mask_tot), _STAT) From 5f43d7629ed0adae3dfbd7fb2f167dcb6464de10 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 30 Jul 2024 08:24:54 -0400 Subject: [PATCH 28/77] Update to ESMA_env v4.30.0 (Baselibs 7.25, Intel 2021.13 --- CHANGELOG.md | 15 +++++++++++++++ components.yaml | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1ec874e9adbc..70ec806ce5cf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,21 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Update Baselibs in CI to 7.25.0 - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 - Update `components.yaml` + - ESMA_env v4.30.0 + - Update to Baselibs 7.25.0 + - ESMF 8.6.1 + - GFE v1.16.0 + - gFTL v1.14.0 + - gFTL-shared v1.9.0 + - fArgParse v1.8.0 + - pFUnit v4.10.0 + - yaFyaml v1.4.0 + - curl 8.8.0 + - NCO 5.2.6 + - Other various fixes from the v8 branch + - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops + - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops + - Move to GEOSpyD Min24.4.4 Python 3.11 - ESMA_cmake v3.48.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs diff --git a/components.yaml b/components.yaml index 014f29f2b77f..21a9ab4486f8 100644 --- a/components.yaml +++ b/components.yaml @@ -5,7 +5,7 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.29.0 + tag: v4.30.0 develop: main ESMA_cmake: From a815f98794559f2602998219c880c7768a3eac10 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 30 Jul 2024 16:41:41 -0400 Subject: [PATCH 29/77] add udunits --- CMakeLists.txt | 1 + cmake/Findudunits.cmake | 68 +++ udunits2f/CMakeLists.txt | 28 ++ udunits2f/CptrWrapper.F90 | 64 +++ udunits2f/UDSystem.F90 | 444 ++++++++++++++++++ udunits2f/encoding.F90 | 17 + udunits2f/error_handling.h | 6 + udunits2f/interfaces.F90 | 138 ++++++ udunits2f/status_codes.F90 | 37 ++ udunits2f/tests/CMakeLists.txt | 26 + udunits2f/tests/Test_UDSystem.pf | 120 +++++ udunits2f/tests/Test_udunits2f.pf | 167 +++++++ udunits2f/udunits2f.F90 | 6 + .../ut_set_ignore_error_message_handler.c | 16 + 14 files changed, 1138 insertions(+) create mode 100644 cmake/Findudunits.cmake create mode 100644 udunits2f/CMakeLists.txt create mode 100644 udunits2f/CptrWrapper.F90 create mode 100644 udunits2f/UDSystem.F90 create mode 100644 udunits2f/encoding.F90 create mode 100644 udunits2f/error_handling.h create mode 100644 udunits2f/interfaces.F90 create mode 100644 udunits2f/status_codes.F90 create mode 100644 udunits2f/tests/CMakeLists.txt create mode 100644 udunits2f/tests/Test_UDSystem.pf create mode 100644 udunits2f/tests/Test_udunits2f.pf create mode 100644 udunits2f/udunits2f.F90 create mode 100644 udunits2f/ut_set_ignore_error_message_handler.c diff --git a/CMakeLists.txt b/CMakeLists.txt index 34a9c4d35e30..241ab190c49d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -229,6 +229,7 @@ add_subdirectory (base) add_subdirectory (MAPL) add_subdirectory (gridcomps) add_subdirectory (griddedio) +add_subdirectory (udunits2f) if (BUILD_WITH_FARGPARSE) add_subdirectory (docs) add_subdirectory (benchmarks) diff --git a/cmake/Findudunits.cmake b/cmake/Findudunits.cmake new file mode 100644 index 000000000000..4978694b91ac --- /dev/null +++ b/cmake/Findudunits.cmake @@ -0,0 +1,68 @@ +# (C) Copyright 2022- UCAR. +# +# Try to find the udunits headers and library +# +# This module defines: +# +# - udunits::udunits - The udunits shared library and include directory, all in a single target. +# - udunits_FOUND - True if udunits was found +# - udunits_INCLUDE_DIR - The include directory +# - udunits_LIBRARY - The library +# - udunits_LIBRARY_SHARED - Whether the library is shared or not +# - udunits_XML_PATH - path to udunits2.xml +# +# The following paths will be searched in order if set in CMake (first priority) or environment (second priority): +# +# - UDUNITS2_INCLUDE_DIRS & UDUNITS2_LIBRARIES - folders containing udunits2.h and libudunits2, respectively. +# - UDUNITS2_ROOT - root of udunits installation +# - UDUNITS2_PATH - root of udunits installation +# +# Notes: +# - The hint variables are capitalized because this is how they are exposed in the jedi stack. +# See https://github.com/JCSDA-internal/jedi-stack/blob/develop/modulefiles/compiler/compilerName/compilerVersion/udunits/udunits.lua for details. + +find_path ( + udunits_INCLUDE_DIR + udunits2.h + HINTS ${UDUNITS2_INCLUDE_DIRS} $ENV{UDUNITS2_INCLUDE_DIRS} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES include include/udunits2 + DOC "Path to udunits2.h" ) + +find_file ( + udunits_XML_PATH + udunits2.xml + HINTS ${UDUNITS2_XML_PATH} $ENV{UDUNITS2_XML_PATH} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES share share/udunits + DOC "Path to udunits2.xml" ) + +find_library(udunits_LIBRARY + NAMES udunits2 udunits + HINTS ${UDUNITS2_LIBRARIES} $ENV{UDUNITS2_LIBRARIES} + ${UDUNITS2_ROOT} $ENV{UDUNITS2_ROOT} + ${UDUNITS2_PATH} $ENV{UDUNITS2_PATH} + PATH_SUFFIXES lib64 lib + DOC "Path to libudunits library" ) + +# We need to support both static and shared libraries +if (udunits_LIBRARY MATCHES ".*\\.a$") + set(udunits_LIBRARY_SHARED FALSE) +else() + set(udunits_LIBRARY_SHARED TRUE) +endif() + +include (FindPackageHandleStandardArgs) +find_package_handle_standard_args (udunits DEFAULT_MSG udunits_LIBRARY udunits_INCLUDE_DIR udunits_XML_PATH) + +mark_as_advanced (udunits_LIBRARY udunits_INCLUDE_DIR udunits_XML_PATH) + +if(udunits_FOUND AND NOT TARGET udunits::udunits) + add_library(udunits::udunits INTERFACE IMPORTED) + set_target_properties(udunits::udunits PROPERTIES INTERFACE_INCLUDE_DIRECTORIES ${udunits_INCLUDE_DIR}) + set_target_properties(udunits::udunits PROPERTIES INTERFACE_LINK_LIBRARIES ${udunits_LIBRARY}) + set_property(TARGET udunits::udunits APPEND PROPERTY INTERFACE_LINK_LIBRARIES ${CMAKE_DL_LIBS}) +endif() + diff --git a/udunits2f/CMakeLists.txt b/udunits2f/CMakeLists.txt new file mode 100644 index 000000000000..9ddd633fc535 --- /dev/null +++ b/udunits2f/CMakeLists.txt @@ -0,0 +1,28 @@ +esma_set_this (OVERRIDE udunits2f) + +set(srcs + CptrWrapper.F90 + UDSystem.F90 + udunits2f.F90 + encoding.F90 + interfaces.F90 + status_codes.F90 + ut_set_ignore_error_message_handler.c + ) +list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}") + +esma_add_library(${this} + SRCS ${srcs} + TYPE SHARED +) + +find_package(udunits REQUIRED) +find_package(EXPAT REQUIRED) + +target_link_libraries(${this} PUBLIC udunits::udunits) +target_link_libraries(${this} PUBLIC EXPAT::EXPAT) + +if (PFUNIT_FOUND) + # Turning off until test with GNU can be fixed + add_subdirectory(tests EXCLUDE_FROM_ALL) +endif () diff --git a/udunits2f/CptrWrapper.F90 b/udunits2f/CptrWrapper.F90 new file mode 100644 index 000000000000..8b0143c6b70b --- /dev/null +++ b/udunits2f/CptrWrapper.F90 @@ -0,0 +1,64 @@ +module ud2f_CptrWrapper + use, intrinsic :: iso_c_binding, only: c_ptr, C_NULL_PTR, c_associated + implicit none + private + + public :: CptrWrapper + +!================================ CPTRWRAPPER ================================== +! Base class to wrap type(c_ptr) instances used for udunits2 objects that cannot +! interface directly to fortran. Each extended class must provide a subroutine +! to free the memory associated with cptr_ + type, abstract :: CptrWrapper + private + type(c_ptr) :: cptr_ = C_NULL_PTR + contains + procedure :: get_cptr + procedure :: set_cptr + procedure :: is_free + procedure :: free + procedure(I_free_memory), deferred :: free_memory + end type CptrWrapper + + abstract interface + + subroutine I_free_memory(this) + import :: CptrWrapper + class(CptrWrapper), intent(in) :: this + end subroutine I_Free_Memory + + end interface + +contains + + type(c_ptr) function get_cptr(this) + class(CptrWrapper), intent(in) :: this + + get_cptr = this%cptr_ + + end function get_cptr + + subroutine set_cptr(this, cptr) + class(CptrWrapper), intent(inout) :: this + type(c_ptr), intent(in) :: cptr + this%cptr_ = cptr + end subroutine set_cptr + + logical function is_free(this) + class(CptrWrapper), intent(in) :: this + + is_free = .not. c_associated(this%cptr_) + + end function is_free + + ! Free up memory pointed to by cptr_ and set cptr_ to c_null_ptr + subroutine free(this) + class(CptrWrapper), intent(inout) :: this + + if(this%is_free()) return + call this%free_memory() + this%cptr_ = c_null_ptr + + end subroutine free + +end module ud2f_CptrWrapper diff --git a/udunits2f/UDSystem.F90 b/udunits2f/UDSystem.F90 new file mode 100644 index 000000000000..0fe1386978ed --- /dev/null +++ b/udunits2f/UDSystem.F90 @@ -0,0 +1,444 @@ +#include "error_handling.h" + +module ud2f_UDSystem + use ud2f_CptrWrapper + use ud2f_interfaces + use ud2f_encoding + use ud2f_status_codes + use iso_c_binding, only: c_ptr, c_associated, c_null_ptr, c_null_char + use iso_c_binding, only: c_char, c_int, c_float, c_double, c_loc + implicit none + private + + public :: Converter + public :: get_converter + public :: initialize + public :: finalize + + public :: UDUnit + public :: are_convertible + public :: UDSystem + public :: cstring + public :: read_xml + public :: ut_free_system + +!================================= CONVERTER =================================== +! Converter object to hold convert functions for an (order) pair of units + type, extends(CptrWrapper) :: Converter + private + contains + procedure :: free_memory => free_cv_converter + procedure, private :: convert_float_0d + procedure, private :: convert_float_1d + procedure, private :: convert_float_2d + procedure, private :: convert_float_3d + procedure, private :: convert_float_4d + procedure, private :: convert_float_5d + procedure, private :: convert_double_0d + procedure, private :: convert_double_1d + procedure, private :: convert_double_2d + procedure, private :: convert_double_3d + procedure, private :: convert_double_4d + procedure, private :: convert_double_5d + + generic :: convert => convert_float_0d + generic :: convert => convert_float_1d + generic :: convert => convert_float_2d + generic :: convert => convert_float_3d + generic :: convert => convert_float_4d + generic :: convert => convert_float_5d + generic :: convert => convert_double_0d + generic :: convert => convert_double_1d + generic :: convert => convert_double_2d + generic :: convert => convert_double_3d + generic :: convert => convert_double_4d + generic :: convert => convert_double_5d + end type Converter + + interface Converter + module procedure :: construct_converter + end interface Converter + +!=============================== UDSYSTEM ================================= +! udunits2 unit system: encoding is the encoding for unit names and symbols. + type, extends(CptrWrapper) :: UDSystem + private + integer(ut_encoding) :: encoding = UT_ASCII + contains + procedure, public, pass(this) :: free_memory => free_ut_system + end type UDSystem + + interface UDSystem + module procedure :: construct_system + end interface UDSystem + +!=================================== UDUNIT ==================================== +! measurement unit in udunits2 system + type, extends(CptrWrapper) :: UDUnit + contains + procedure, public, pass(this) :: free_memory => free_ut_unit + end type UDUnit + + interface UDUnit + module procedure :: construct_unit + end interface UDUnit + + interface are_convertible + procedure :: are_convertible_udunit + procedure :: are_convertible_str + end interface are_convertible + +!============================= INSTANCE VARIABLES ============================== +! Single instance of units system. There is one system in use, only. + type(UDSystem), private :: SYSTEM_INSTANCE + +contains + + ! Check the status for the last udunits2 call + logical function success(utstatus) + integer(ut_status) :: utstatus + + success = (utstatus == UT_SUCCESS) + + end function success + + function construct_system(path, encoding) result(instance) + type(UDsystem) :: instance + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + type(c_ptr) :: utsystem + integer(ut_status) :: status + + ! Read in unit system from path + call read_xml(path, utsystem, status) + + if(success(status)) then + call instance%set_cptr(utsystem) + if(present(encoding)) instance%encoding = encoding + return + end if + + ! Free memory in the case of failure + if(c_associated(utsystem)) call ut_free_system(utsystem) + + end function construct_system + + function construct_unit(identifier) result(instance) + type(UDUnit) :: instance + character(len=*), intent(in) :: identifier + character(kind=c_char, len=:), allocatable :: cchar_identifier + type(c_ptr) :: utunit1 + + ! Unit system must be initialized (instantiated). + if(instance_is_uninitialized()) return + + cchar_identifier = cstring(identifier) + utunit1 = ut_parse(SYSTEM_INSTANCE%get_cptr(), cchar_identifier, SYSTEM_INSTANCE%encoding) + + if(success(ut_get_status())) then + call instance%set_cptr(utunit1) + else + ! Free memory in the case of failure + if(c_associated(utunit1)) call ut_free(utunit1) + end if + + end function construct_unit + + function construct_converter(from_unit, to_unit) result(conv) + type(Converter) :: conv + type(UDUnit), intent(in) :: from_unit + type(UDUnit), intent(in) :: to_unit + type(c_ptr) :: cvconverter1 + logical :: convertible + + ! Must supply units that are initialized and convertible + if(from_unit%is_free() .or. to_unit%is_free()) return + if(.not. are_convertible(from_unit, to_unit)) return + + cvconverter1 = ut_get_converter(from_unit%get_cptr(), to_unit%get_cptr()) + + if(success(ut_get_status())) then + call conv%set_cptr(cvconverter1) + else + ! Free memory in the case of failure + if(c_associated(cvconverter1)) call cv_free(cvconverter1) + end if + + end function construct_converter + + ! Get Converter object based on unit names or symbols + subroutine get_converter(conv, from, to, rc) + type(Converter),intent(inout) :: conv + character(len=*), intent(in) :: from, to + integer(ut_status), optional, intent(out) :: rc + integer(ut_status) :: status + + conv = get_converter_function(from, to) + _ASSERT(.not. conv%is_free(), UTF_CONVERTER_NOT_INITIALIZED) + + _RETURN(UT_SUCCESS) + end subroutine get_converter + + ! Get converter object + function get_converter_function(from, to) result(conv) + type(Converter) :: conv + character(len=*), intent(in) :: from, to + type(UDUnit) :: from_unit + type(UDUnit) :: to_unit + + ! Unit system must be initialized (instantiated). + if(instance_is_uninitialized()) return + + ! Get units based on strings. Free memory on fail. + from_unit = UDUnit(from) + if(from_unit%is_free()) return + to_unit = UDUnit(to) + if(to_unit%is_free()) then + call from_unit%free() + return + end if + + conv = Converter(from_unit, to_unit) + + ! Units are no longer needed + call from_unit%free() + call to_unit%free() + + end function get_converter_function + + function convert_float_0d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from + real(c_float) :: to + to = cv_convert_float(this%get_cptr(), from) + end function convert_float_0d + + function convert_float_1d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:) + real(c_float) :: to(size(from)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_1d + + function convert_float_2d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:) + real(c_float) :: to(size(from,1), size(from,2)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_2d + + function convert_float_3d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_3d + + function convert_float_4d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3), size(from,4)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_4d + + function convert_float_5d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_float), intent(in) :: from(:,:,:,:,:) + real(c_float) :: to(size(from,1), size(from,2), size(from,3), size(from,4), size(from,5)) + call cv_convert_floats(this%get_cptr(), from, size(from), to) + end function convert_float_5d + + function convert_double_0d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from + real(c_double) :: to + to = cv_convert_double(this%get_cptr(), from) + end function convert_double_0d + + function convert_double_1d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:) + real(c_double) :: to(size(from)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_1d + + function convert_double_2d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:) + real(c_double) :: to(size(from,1), size(from,2)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_2d + + function convert_double_3d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_3d + + function convert_double_4d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3), size(from,4)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_4d + + function convert_double_5d(this, from) result(to) + class(Converter), intent(in) :: this + real(c_double), intent(in) :: from(:,:,:,:,:) + real(c_double) :: to(size(from,1), size(from,2), size(from,3), size(from,4), size(from,5)) + call cv_convert_doubles(this%get_cptr(), from, size(from), to) + end function convert_double_5d + + ! Read unit database from XML + subroutine read_xml(path, utsystem, status) + character(len=*), optional, intent(in) :: path + type(c_ptr), intent(out) :: utsystem + integer(ut_status), intent(out) :: status + + character(kind=c_char, len=:), target, allocatable :: cchar_path + + if(present(path)) then + cchar_path = cstring(path) + utsystem = ut_read_xml_cptr(c_loc(cchar_path)) + else + utsystem = ut_read_xml_cptr(c_null_ptr) + end if + status = ut_get_status() + + end subroutine read_xml + + ! Initialize unit system instance + subroutine initialize(path, encoding, rc) + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + integer, optional, intent(out) :: rc + integer :: status + + _RETURN_UNLESS(instance_is_uninitialized()) + ! System must be once and only once. + _ASSERT(instance_is_uninitialized(), UTF_DUPLICATE_INITIALIZATION) + + ! Disable error messages from udunits2 + call disable_ut_error_message_handler() + + call initialize_system(SYSTEM_INSTANCE, path, encoding, rc=status) + if(status /= UT_SUCCESS) then + ! On failure, free memory + call finalize() + _RETURN(UTF_INITIALIZATION_FAILURE) + end if + _ASSERT(.not. SYSTEM_INSTANCE%is_free(), UTF_NOT_INITIALIZED) + _RETURN(UT_SUCCESS) + + end subroutine initialize + + subroutine initialize_system(system, path, encoding, rc) + type(UDSystem), intent(inout) :: system + character(len=*), optional, intent(in) :: path + integer(ut_encoding), optional, intent(in) :: encoding + integer, optional, intent(out) :: rc + integer :: status + type(c_ptr) :: utsystem + + ! A system can be initialized only once. + _ASSERT(system%is_free(), UTF_DUPLICATE_INITIALIZATION) + + system = UDSystem(path, encoding) + _RETURN(UT_SUCCESS) + end subroutine initialize_system + + ! Is the instance of the unit system initialized? + logical function instance_is_uninitialized() + + instance_is_uninitialized = SYSTEM_INSTANCE%is_free() + + end function instance_is_uninitialized + + ! Free memory for unit system + subroutine free_ut_system(this) + class(UDSystem), intent(in) :: this + + if(this%is_free()) return + call ut_free_system(this%get_cptr()) + + end subroutine free_ut_system + + ! Free memory for unit + subroutine free_ut_unit(this) + class(UDUnit), intent(in) :: this + + if(this%is_free()) return + call ut_free(this%get_cptr()) + + end subroutine free_ut_unit + + ! Free memory for converter + subroutine free_cv_converter(this) + class(Converter), intent(in) :: this + type(c_ptr) :: cvconverter1 + + if(this%is_free()) return + call cv_free(this%get_cptr()) + + end subroutine free_cv_converter + + ! Free memory for unit system instance + subroutine finalize() + + if(SYSTEM_INSTANCE%is_free()) return + call SYSTEM_INSTANCE%free() + + end subroutine finalize + + ! Check if units are convertible + function are_convertible_udunit(unit1, unit2, rc) result(convertible) + logical :: convertible + type(UDUnit), intent(in) :: unit1, unit2 + integer, optional, intent(out) :: rc + integer :: status + integer(c_int), parameter :: ZERO = 0_c_int + + convertible = (ut_are_convertible(unit1%get_cptr(), unit2%get_cptr()) /= ZERO) + status = ut_get_status() + _ASSERT(success(status), status) + + _RETURN(UT_SUCCESS) + end function are_convertible_udunit + + ! Check if units are convertible + function are_convertible_str(from, to, rc) result(convertible) + logical :: convertible + character(*), intent(in) :: from, to + integer, optional, intent(out) :: rc + + integer :: status + type(UDUnit) :: unit1, unit2 + + unit1 = UDUnit(from) + unit2 = UDUnit(to) + convertible = are_convertible_udunit(unit1, unit2, _RC) + + _RETURN(UT_SUCCESS) + end function are_convertible_str + + ! Create C string from Fortran string + function cstring(s) result(cs) + character(len=*), intent(in) :: s + character(kind=c_char, len=:), allocatable :: cs + + cs = adjustl(trim(s)) // c_null_char + + end function cstring + + ! Set udunits2 error handler to ut_ignore which does nothing + subroutine disable_ut_error_message_handler(is_set) + logical, optional, intent(out) :: is_set + logical, save :: handler_set = .FALSE. + + if(.not. handler_set) call ut_set_ignore_error_message_handler() + handler_set = .TRUE. + if(present(is_set)) is_set = handler_set + end subroutine disable_ut_error_message_handler + +end module ud2f_UDSystem diff --git a/udunits2f/encoding.F90 b/udunits2f/encoding.F90 new file mode 100644 index 000000000000..0daa08205deb --- /dev/null +++ b/udunits2f/encoding.F90 @@ -0,0 +1,17 @@ +! Flags for encodings for unit names and symbols +! The values are the same as the udunits2 utEncoding C enum +module ud2f_encoding + implicit none + public + + enum, bind(c) + enumerator :: UT_ASCII = 0 + enumerator :: UT_ISO_8859_1 = 1 + enumerator :: UT_LATIN1 = UT_ISO_8859_1 + enumerator :: UT_UTF8 = 2 + enumerator :: UT_ENCODING_DEFAULT = UT_ASCII + end enum + integer, parameter :: ut_encoding = kind(UT_ENCODING_DEFAULT) + +end module ud2f_encoding + diff --git a/udunits2f/error_handling.h b/udunits2f/error_handling.h new file mode 100644 index 000000000000..78892070d455 --- /dev/null +++ b/udunits2f/error_handling.h @@ -0,0 +1,6 @@ +#define _RETURN(status) if(present(rc)) then; rc=status; return; endif +#define _RETURN_UNLESS(cond) if (.not. cond) then; _RETURN(UT_SUCCESS); endif +#define _ASSERT(cond, msg) if (.not. (cond)) then; _RETURN(msg); endif +#define _RC rc=status); _ASSERT(rc==UT_SUCCESS, status + +!rc=status); if (.not. (rc==UT_SUCCESS)) then; if(present(rc)) then; rc=status; return; endif; endif diff --git a/udunits2f/interfaces.F90 b/udunits2f/interfaces.F90 new file mode 100644 index 000000000000..34d47e205f50 --- /dev/null +++ b/udunits2f/interfaces.F90 @@ -0,0 +1,138 @@ +module ud2f_interfaces + use ud2f_encoding, only: ut_encoding + use ud2f_status_codes, only: ut_status + use, intrinsic :: iso_c_binding, only: c_ptr, c_char, c_int, c_float, c_double + implicit none + private + + public :: ut_get_status, ut_parse + public :: ut_read_xml_cptr + public :: ut_get_converter, ut_are_convertible + public :: cv_convert_double, cv_convert_float + public :: cv_convert_doubles, cv_convert_floats + public :: ut_free, ut_free_system, cv_free + public :: ut_set_ignore_error_message_handler + interface + + ! Procedures that return type(c_ptr) return a C null pointer on failure. + ! However, checking for the C null pointer IS NOT a good check for status. + ! ut_get_status is a better check, where UT_SUCCESS indicates success. + + ! Return type(c_ptr) to ut_system units database specified by path + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + type(c_ptr) function ut_read_xml_cptr(path) bind(c, name='ut_read_xml') + import :: c_ptr + type(c_ptr), value :: path + end function ut_read_xml_cptr + + ! Get status code + integer(ut_status) function ut_get_status() bind(c, name='ut_get_status') + import :: ut_status + end function ut_get_status + + ! Return non-zero value if unit1 can be converted to unit2, otherwise 0 + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + integer(c_int) function ut_are_convertible(unit1, unit2) & + bind(c, name='ut_are_convertible') + import :: c_int, c_ptr + type(c_ptr), value, intent(in) :: unit1, unit2 + end function ut_are_convertible + + ! Return type(c_ptr) to cv_converter + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + type(c_ptr) function ut_get_converter(from, to) & + bind(c, name='ut_get_converter') + import :: c_ptr + type(c_ptr), value, intent(in) :: from, to + end function ut_get_converter + + ! Use converter to convert value_ + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + real(c_float) function cv_convert_float(converter, value_) bind(c) + import :: c_ptr, c_float + type(c_ptr), value, intent(in) :: converter + real(c_float), value, intent(in) :: value_ + end function cv_convert_float + + ! Use converter to convert value_ + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + real(c_double) function cv_convert_double(converter, value_) bind(c) + import :: c_ptr, c_double + type(c_ptr), value, intent(in) :: converter + real(c_double), value, intent(in) :: value_ + end function cv_convert_double + + ! Use converter to convert in_ and put it in out_. + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + subroutine cv_convert_doubles(converter, in_, count_, out_) & + bind(c, name='cv_convert_doubles') + import :: c_double, c_int, c_ptr + type(c_ptr), value, intent(in) :: converter + real(c_double), intent(in) :: in_(*) + integer(c_int), value, intent(in) :: count_ + real(c_double), intent(out) :: out_(count_) + end subroutine cv_convert_doubles + + ! Use converter to convert in_ and put it in out_. + ! Use ut_get_status to check error condition. + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + subroutine cv_convert_floats(converter, in_, count_, out_) & + bind(c, name='cv_convert_floats') + import :: c_ptr, c_float, c_int + type(c_ptr), value, intent(in) :: converter + real(c_float), intent(in) :: in_(*) + integer(c_int), value, intent(in) :: count_ + real(c_float), intent(out) :: out_(count_) + end subroutine cv_convert_floats + + ! Return type(c_ptr) to ut_unit + ! UT_SUCCESS indicates that the function ran successfully. + ! Other ut_status codes indicate cause of failure. + ! Use ut_get_status to check error condition. + type(c_ptr) function ut_parse(system, string, encoding) & + bind(c, name='ut_parse') + import :: c_ptr, c_char, ut_encoding + type(c_ptr), value, intent(in) :: system + character(c_char), intent(in) :: string(*) + integer(ut_encoding), value, intent(in) :: encoding + end function ut_parse + + ! Free memory for ut_system + subroutine ut_free_system(system) bind(c, name='ut_free_system') + import :: c_ptr + type(c_ptr), value :: system + end subroutine ut_free_system + + ! Free memory for ut_unit + subroutine ut_free(unit) bind(c, name='ut_free') + import :: c_ptr + type(c_ptr), value :: unit + end subroutine ut_free + + ! Free memory for cv_converter + subroutine cv_free(conv) bind(c, name='cv_free') + import :: c_ptr + type(c_ptr), value :: conv + end subroutine cv_free + + ! Set udunits error handler to ut_ignore (do nothing) + subroutine ut_set_ignore_error_message_handler() & + bind(c, name='ut_set_ignore_error_message_handler') + end subroutine ut_set_ignore_error_message_handler + + end interface + +end module ud2f_interfaces diff --git a/udunits2f/status_codes.F90 b/udunits2f/status_codes.F90 new file mode 100644 index 000000000000..d57338aeb5c8 --- /dev/null +++ b/udunits2f/status_codes.F90 @@ -0,0 +1,37 @@ +! Status values for udunits2 procedures +! The values are the same as the udunits2 utStatus C enum +module ud2f_status_codes + + implicit none + + enum, bind(c) + enumerator :: & + UT_SUCCESS = 0, & ! Success + UT_BAD_ARG, & ! An argument violates the function's contract + UT_EXISTS, & ! Unit, prefix, or identifier already exists + UT_NO_UNIT, & ! No such unit exists + UT_OS, & ! Operating-system error. See "errno". + UT_NOT_SAME_SYSTEM, & ! The units belong to different unit-systems + UT_MEANINGLESS, & ! The operation on the unit(s) is meaningless + UT_NO_SECOND, & ! The unit-system doesn't have a unit named "second" + UT_VISIT_ERROR, & ! An error occurred while visiting a unit + UT_CANT_FORMAT, & ! A unit can't be formatted in the desired manner + UT_SYNTAX, & ! string unit representation contains syntax error + UT_UNKNOWN, & ! string unit representation contains unknown word + UT_OPEN_ARG, & ! Can't open argument-specified unit database + UT_OPEN_ENV, & ! Can't open environment-specified unit database + UT_OPEN_DEFAULT, & ! Can't open installed, default, unit database + UT_PARSE_ERROR ! Error parsing unit specification + end enum + integer, parameter :: ut_status = kind(UT_SUCCESS) + + enum, bind(c) + enumerator :: & + UTF_DUPLICATE_INITIALIZATION = 100, & + UTF_CONVERTER_NOT_INITIALIZED, & + UTF_NOT_INITIALIZED, & + UTF_INITIALIZATION_FAILURE + + end enum + +end module ud2f_status_codes diff --git a/udunits2f/tests/CMakeLists.txt b/udunits2f/tests/CMakeLists.txt new file mode 100644 index 000000000000..7b5be2e4b42a --- /dev/null +++ b/udunits2f/tests/CMakeLists.txt @@ -0,0 +1,26 @@ +set(MODULE_DIRECTORY "${esma_include}/udunits2f.tests") + +set (test_srcs + Test_UDSystem.pf + Test_udunits2f.pf + ) + +add_pfunit_ctest(udunits2f.tests + TEST_SOURCES ${test_srcs} + LINK_LIBRARIES udunits2f + ) +set_target_properties(udunits2f.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) +set_tests_properties(udunits2f.tests PROPERTIES LABELS "ESSENTIAL") + +# With this test, it was shown that if you are building with the GNU Fortran +# compiler and *not* on APPLE, then you need to link with the dl library. +if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU" AND NOT APPLE) + target_link_libraries(udunits2f.tests ${CMAKE_DL_LIBS}) +endif () + +# This test requires UDUNITS2_XML_PATH to be set to the location of the udunits2.xml file +# This is found by Findudunits.cmake and stored in the variable udunits_XML_PATH +set_tests_properties(udunits2f.tests PROPERTIES ENVIRONMENT "UDUNITS2_XML_PATH=${udunits_XML_PATH}") + +add_dependencies(build-tests udunits2f.tests) + diff --git a/udunits2f/tests/Test_UDSystem.pf b/udunits2f/tests/Test_UDSystem.pf new file mode 100644 index 000000000000..14f8979a656d --- /dev/null +++ b/udunits2f/tests/Test_UDSystem.pf @@ -0,0 +1,120 @@ +module Test_UDsystem + + use funit + use ud2f_UDSystem, finalize_udunits_system => finalize, initialize_udunits_system => initialize + use udunits2f + use iso_c_binding, only: c_ptr, c_double, c_float, c_associated + + implicit none + + integer(ut_encoding), parameter :: ENCODING = UT_ASCII + character(len=*), parameter :: KM = 'km' + character(len=*), parameter :: M = 'm' + character(len=*), parameter :: S = 's' + +contains + + @Test + subroutine test_get_converter() + type(Converter) :: conv + type(c_ptr) :: cptr + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, KM, M, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + @assertFalse(conv%is_free(), 'cv_converter is not set') + cptr = conv%get_cptr() + @assertTrue(c_associated(cptr), 'c_ptr is not associated') + + call conv%free() + call finalize_udunits_system() + + end subroutine test_get_converter + + @Test + subroutine test_convert_double() + real(c_double), parameter :: FROM = 1.0 + real(c_double), parameter :: EXPECTED = 1000.0 + real(c_double) :: actual + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_double + + @Test + subroutine test_convert_float() + real(c_float), parameter :: FROM = 1.0 + real(c_float), parameter :: EXPECTED = 1000.0 + real(c_float) :: actual + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_float + + @Test + subroutine test_convert_doubles() + real(c_double), parameter :: FROM(3) = [1.0, 2.0, 3.0] + real(c_double), parameter :: EXPECTED(3) = 1000.0 * FROM + real(c_double) :: actual(size(EXPECTED)) + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_doubles + + @Test + subroutine test_convert_floats() + real(c_float), parameter :: FROM(3) = [1.0, 2.0, 3.0] + real(c_float), parameter :: EXPECTED(3) = 1000.0 * FROM + real(c_float) :: actual(size(EXPECTED)) + type(Converter) :: conv + integer(ut_status) :: status + character(len=*), parameter :: FROM_STRING = KM + character(len=*), parameter :: TO_STRING = M + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + call get_converter(conv, FROM_STRING, TO_STRING, rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to get converter') + actual = conv%convert(FROM) + @assertEqual(actual, EXPECTED, 'Actual does not equal expected.') + call conv%free() + call finalize_udunits_system() + + end subroutine test_convert_floats + +end module Test_UDsystem diff --git a/udunits2f/tests/Test_udunits2f.pf b/udunits2f/tests/Test_udunits2f.pf new file mode 100644 index 000000000000..ec51c125b14c --- /dev/null +++ b/udunits2f/tests/Test_udunits2f.pf @@ -0,0 +1,167 @@ +module Test_udunits2f + + use funit + use ud2f_UDSystem, finalize_udunits_system => finalize, initialize_udunits_system => initialize + use udunits2f + use iso_c_binding, only: c_ptr, c_associated, c_char, c_null_char + + implicit none + + integer(ut_encoding), parameter :: ENCODING = UT_ASCII + character(len=*), parameter :: KM = 'km' + character(len=*), parameter :: M = 'm' + character(len=*), parameter :: S = 's' + +contains + + @Test + subroutine test_construct_system_no_path() + type(UDSystem) :: wrapper + + wrapper = UDSystem() + @assertFalse(wrapper%is_free(), 'ut_system is not set') + call ut_free_system(wrapper%get_cptr()) + + end subroutine test_construct_system_no_path + + @Test + subroutine test_cptr_wrapper() + type(UDSystem) :: wrapper + type(c_ptr) :: cptr + logical :: cassoc + + wrapper = UDSystem() + cptr = wrapper%get_cptr() + cassoc = c_associated(cptr) + @assertTrue(cassoc, 'Did not get c_ptr') + if(cassoc) then + @assertFalse(wrapper%is_free(), 'c_ptr should be set.') + call wrapper%free() + cptr = wrapper%get_cptr() + @assertFalse(c_associated(cptr), 'c_ptr should not be associated') + @assertTrue(wrapper%is_free(), 'c_ptr should not be set') + end if + if(c_associated(cptr)) call ut_free_system(cptr) + + end subroutine test_cptr_wrapper + + @Test + subroutine test_construct_unit() + type(UDUnit) :: unit1 + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + @assertFalse(unit1%is_free(), 'ut_unit is not set (default encoding)') + + call unit1%free() + call finalize_udunits_system() + + end subroutine test_construct_unit + + @Test + subroutine test_construct_converter() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + type(Converter) :: conv + integer(ut_status) :: status + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(M) + conv = Converter(unit1, unit2) + @assertFalse(conv%is_free(), 'cv_converter is not set') + + call unit1%free() + call unit2%free() + call conv%free() + call finalize_udunits_system() + + end subroutine test_construct_converter + + @Test + subroutine test_read_xml_nopath() + integer :: status + type(c_ptr) :: utsystem + + call read_xml(utsystem=utsystem, status=status) + if(.not. c_associated(utsystem)) then + @assertFalse(status == UT_OS, 'Operating system error') + @assertFalse(status == UT_PARSE_ERROR, 'Database file could not be parsed.') + @assertFalse(status == UT_OPEN_ARG, 'Non-null path could not be opened.') + @assertFalse(status == UT_OPEN_ENV, 'Environment variable is set but could not open.') + @assertFalse(status == UT_OPEN_DEFAULT, 'Default database could not be opened.') + end if + + call ut_free_system(utsystem) + + end subroutine test_read_xml_nopath + + @Test + subroutine test_cstring() + character(len=*), parameter :: fs = 'FOO_BAR' + character(kind=c_char, len=80) :: cchs + character(kind=kind(cchs)) :: cc + integer :: n + + cchs = cstring(fs) + @assertEqual(kind((cchs)), c_char, 'Wrong kind') + n = len_trim(cchs) + @assertEqual(n, len(fs)+1, 'cstring is incorrect length.') + cc = cchs(n:n) + @assertEqual(cc, c_null_char, 'Final character is not null.') + @assertEqual(cchs(1:(n-1)), fs, 'Initial characters do not match.') + + end subroutine test_cstring + + @Test + subroutine test_are_convertible() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + integer(ut_status) :: status + logical :: convertible + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(M) + convertible = are_convertible(unit1, unit2, rc=status) + if(.not. convertible) then + @assertFalse(status == UT_BAD_ARG, 'One of the units is null.') + @assertFalse(status == UT_NOT_SAME_SYSTEM, 'Units belong to different systems.') + end if + + call unit1%free() + call unit2%free() + call finalize_udunits_system() + + end subroutine test_are_convertible + + @Test + subroutine test_are_not_convertible() + type(UDUnit) :: unit1 + type(UDUnit) :: unit2 + integer(ut_status) :: status + logical :: convertible + + call initialize_udunits_system(rc=status) + @assertEqual(UT_SUCCESS, status, 'Failed to initialize') + unit1 = UDUnit(KM) + unit2 = UDUnit(S) + convertible = are_convertible(unit1, unit2, rc=status) + @assertFalse(convertible, 'Units are not convertible.') + if(.not. convertible) then + @assertFalse(status == UT_BAD_ARG, 'One of the units is null.') + @assertFalse(status == UT_NOT_SAME_SYSTEM, 'Units belong to different systems.') + @assertTrue(status == UT_SUCCESS, 'Units are not convertible.') + end if + + call unit1%free() + call unit2%free() + call finalize_udunits_system() + + end subroutine test_are_not_convertible + +end module Test_udunits2f diff --git a/udunits2f/udunits2f.F90 b/udunits2f/udunits2f.F90 new file mode 100644 index 000000000000..e6d07b2ff8a2 --- /dev/null +++ b/udunits2f/udunits2f.F90 @@ -0,0 +1,6 @@ +module udunits2f + use ud2f_interfaces + use ud2f_encoding + use ud2f_status_codes + use ud2f_UDsystem +end module udunits2f diff --git a/udunits2f/ut_set_ignore_error_message_handler.c b/udunits2f/ut_set_ignore_error_message_handler.c new file mode 100644 index 000000000000..f20637a5140c --- /dev/null +++ b/udunits2f/ut_set_ignore_error_message_handler.c @@ -0,0 +1,16 @@ +#include +#include +#include "udunits2.h" + +/* Helper function to augment udunits2 error handling + * Sets the udunits2 error handler to ut_ignore + * which disables error messages from udunits2 + * udunits2 requires a ut_error_message_handler be passed + * into ut_set_error_message_handler to change the error handler, + * and ut_error_message_handler is a function with a variadic list + * of arguments, which is not possible in Fortran. +*/ +ut_error_message_handler ut_set_ignore_error_message_handler() +{ + return ut_set_error_message_handler(ut_ignore); +} From 35e1d06d97229d4f4b720c2a61b64c2ea2e2eb76 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 30 Jul 2024 17:00:58 -0400 Subject: [PATCH 30/77] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1ec874e9adbc..02d6aeed0260 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Added Fortran interface to UDUNITS2 - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - Update Baselibs in CI to 7.25.0 - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 From e6a40c9ecff56035c5c0a9b894fcec3bc951420e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 31 Jul 2024 10:02:03 -0400 Subject: [PATCH 31/77] Clarify changelog for udunits dependency --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 02d6aeed0260..7f5ff6bfb478 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Added Fortran interface to UDUNITS2 + - NOTE: This now means MAPL depends on UDUNITS2 (and transitively, expat) - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - Update Baselibs in CI to 7.25.0 - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 From b14b29cdcb51759d44147461743ac92d9d4c9c15 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 31 Jul 2024 10:48:31 -0400 Subject: [PATCH 32/77] Make cmake look like MAPL3 --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 241ab190c49d..9ade44fe72f7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -218,6 +218,7 @@ if (APPLE) add_compile_definitions("-D__DARWIN") endif() +add_subdirectory (udunits2f) add_subdirectory (pfio) add_subdirectory (profiler) add_subdirectory (generic) @@ -229,7 +230,6 @@ add_subdirectory (base) add_subdirectory (MAPL) add_subdirectory (gridcomps) add_subdirectory (griddedio) -add_subdirectory (udunits2f) if (BUILD_WITH_FARGPARSE) add_subdirectory (docs) add_subdirectory (benchmarks) From 690649a8c203abe745d323ee6f134b4775c3afb1 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 31 Jul 2024 11:24:01 -0400 Subject: [PATCH 33/77] Fixes #2926. Update quantize output --- Apps/Regrid_Util.F90 | 2 +- CHANGELOG.md | 3 +++ gridcomps/History/MAPL_HistoryGridComp.F90 | 8 +++++--- griddedio/GriddedIO.F90 | 24 ++++++++++++++++++++-- pfio/Variable.F90 | 4 ++-- shared/Constants/InternalConstants.F90 | 2 +- 6 files changed, 34 insertions(+), 9 deletions(-) diff --git a/Apps/Regrid_Util.F90 b/Apps/Regrid_Util.F90 index 8b4810c4d073..3e472d62d345 100644 --- a/Apps/Regrid_Util.F90 +++ b/Apps/Regrid_Util.F90 @@ -96,7 +96,7 @@ subroutine process_command_line(this,rc) this%lat_range=uninit this%shave=64 this%deflate=0 - this%quantize_algorithm=1 + this%quantize_algorithm=0 this%quantize_level=0 this%use_weights = .false. nargs = command_argument_count() diff --git a/CHANGELOG.md b/CHANGELOG.md index 02d6aeed0260..8d5e32194827 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +- Deprecate `GranularBR` as a quantization method keyword in History. We will prefer `granular_bitround` in the future to match + draft CF conventions. This will be removed in MAPL 3. + ## [2.47.1] - 2024-07-17 ### Fixed diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4b048912bd70..556d12f9e5f4 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -839,18 +839,20 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) label=trim(string) // 'quantize_algorithm:' ,_RC ) ! Uppercase the algorithm string just to allow for any case + ! CF Conventions will prefer 'bitgroom', 'bitround', and 'granular_bitround' + ! but we will allow 'GranularBR' in MAPL2, deprecate it, and remove it in MAPL3 uppercase_algorithm = ESMF_UtilStringUpperCase(list(n)%quantize_algorithm_string,_RC) select case (trim(uppercase_algorithm)) case ('NONE') list(n)%quantize_algorithm = MAPL_Quantize_Disabled case ('BITGROOM') list(n)%quantize_algorithm = MAPL_Quantize_BitGroom - case ('GRANULARBR') - list(n)%quantize_algorithm = MAPL_Quantize_GranularBR + case ('GRANULARBR', 'GRANULAR_BITROUND') + list(n)%quantize_algorithm = MAPL_Quantize_Granular_BitRound case ('BITROUND') list(n)%quantize_algorithm = MAPL_Quantize_BitRound case default - _FAIL('Invalid quantize_algorithm. Allowed values are NONE, BitGroom, GranularBR, BitRound') + _FAIL('Invalid quantize_algorithm. Allowed values are NONE, bitgroom, granular_bitround, granularbr (deprecated), and bitround') end select call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_level, default=0, & diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index fe2e6fb45be5..f1817666edfb 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -190,7 +190,6 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr call this%timeInfo%add_time_to_metadata(this%metadata,rc=status) _VERIFY(status) - iter = this%items%begin() if (.not.allocated(this%chunking)) then call this%set_default_chunking(rc=status) _VERIFY(status) @@ -198,11 +197,11 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr call this%check_chunking(this%vdata%lm,_RC) end if - order = this%metadata%get_order(rc=status) _VERIFY(status) metadataVarsSize = order%size() + iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() if (item%itemType == ItemTypeScalar) then @@ -423,6 +422,27 @@ subroutine CreateVariable(this,itemName,rc) #else call v%add_attribute('regrid_method', regrid_method_int_to_string(this%regrid_method)) #endif + ! The CF Convention will soon support quantization. This requires three new attributes + ! if enabled: + ! 1. quantization --> Will point to a quantization_info containter with the quantization algorithm + ! 2a. quantization_nsb --> Number of significant bits (only for bitround) + ! 2b. quantization_nsd --> Number of significant digits (only for bitgroom and granular_bitgroom) + ! 3. quantization_maximum_relative_error --> Maximum relative error (defined as 2^(-nsb) for bitround, and UNDEFINED? for bitgroom and granular_bitgroom) + + ! Bitround ==> 1 + if (this%quantizeAlgorithm == 1) then + call v%add_attribute('quantization', 'quantization_info') + call v%add_attribute('quantization_nsb', this%quantizeLevel) + call v%add_attribute('quantization_maximum_relative_error', 0.5 * 2.0**(-this%quantizeLevel)) + end if + ! granular_bitgroom ==> 2, bitgroom ==> 3 + if (this%quantizeAlgorithm == 2 .or. this%quantizeAlgorithm == 3) then + call v%add_attribute('quantization', 'quantization_info') + call v%add_attribute('quantization_nsd', this%quantizeLevel) + ! For now, don't add this until we know what to do + !call v%add_attribute('quantization_maximum_relative_error', 0.5 * 2.0**(-this%quantizeLevel)) + end if + call factory%append_variable_metadata(v) call this%metadata%add_variable(trim(varName),v,rc=status) _VERIFY(status) diff --git a/pfio/Variable.F90 b/pfio/Variable.F90 index 9d42cf97f7f2..67344a40fa5b 100644 --- a/pfio/Variable.F90 +++ b/pfio/Variable.F90 @@ -28,7 +28,7 @@ module pFIO_VariableMod type (StringAttributeMap) :: attributes type (UnlimitedEntity) :: const_value integer :: deflation = 0 ! default no compression - integer :: quantize_algorithm = 1 ! default bitgroom + integer :: quantize_algorithm = 0 ! default no quantize_algorithm integer :: quantize_level = 0 ! default no quantize_level integer, allocatable :: chunksizes(:) contains @@ -85,7 +85,7 @@ function new_Variable(unusable, type, dimensions, chunksizes,const_value, deflat var%type = -1 var%deflation = 0 - var%quantize_algorithm = 1 + var%quantize_algorithm = 0 var%quantize_level = 0 var%chunksizes = empty var%dimensions = StringVector() diff --git a/shared/Constants/InternalConstants.F90 b/shared/Constants/InternalConstants.F90 index ac2935ea9911..57a8c8eda94b 100644 --- a/shared/Constants/InternalConstants.F90 +++ b/shared/Constants/InternalConstants.F90 @@ -170,7 +170,7 @@ module MAPL_InternalConstantsMod enum, bind(c) enumerator MAPL_Quantize_Disabled enumerator MAPL_Quantize_BitGroom - enumerator MAPL_Quantize_GranularBR + enumerator MAPL_Quantize_Granular_BitRound enumerator MAPL_Quantize_BitRound endenum ! Constant masking From 58f9f7e84126bd66aa1549fa133a2b3acf7aae79 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 31 Jul 2024 15:44:56 -0400 Subject: [PATCH 34/77] Add new quantization_info --- CHANGELOG.md | 3 + gridcomps/History/MAPL_HistoryGridComp.F90 | 28 ++++---- griddedio/GriddedIO.F90 | 75 +++++++++++++++++++--- pfio/Variable.F90 | 2 +- shared/Constants/InternalConstants.F90 | 10 +-- 5 files changed, 87 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8d5e32194827..a6612b17748a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - ESMA_cmake v3.48.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs +- Add support for preliminary CF Conventions quantization properties + - Add new quantization keyword `granular_bitround` to History. This will be the preferred keyword for quantization in the future + replacing `GranularBR` ### Fixed diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 556d12f9e5f4..f86135d6880e 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -838,38 +838,34 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_algorithm_string, default='NONE', & label=trim(string) // 'quantize_algorithm:' ,_RC ) + call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_level, default=0, & + label=trim(string) // 'quantize_level:' ,_RC ) + ! Uppercase the algorithm string just to allow for any case ! CF Conventions will prefer 'bitgroom', 'bitround', and 'granular_bitround' ! but we will allow 'GranularBR' in MAPL2, deprecate it, and remove it in MAPL3 uppercase_algorithm = ESMF_UtilStringUpperCase(list(n)%quantize_algorithm_string,_RC) select case (trim(uppercase_algorithm)) case ('NONE') - list(n)%quantize_algorithm = MAPL_Quantize_Disabled + list(n)%quantize_algorithm = MAPL_NOQUANTIZE + ! If quantize_algorithm is 0, then quantize_level must be 0 + _ASSERT( list(n)%quantize_level == 0, 'quantize_algorithm is none, so quantize_level must be "none"') case ('BITGROOM') - list(n)%quantize_algorithm = MAPL_Quantize_BitGroom + list(n)%quantize_algorithm = MAPL_QUANTIZE_BITGROOM case ('GRANULARBR', 'GRANULAR_BITROUND') - list(n)%quantize_algorithm = MAPL_Quantize_Granular_BitRound + list(n)%quantize_algorithm = MAPL_QUANTIZE_GRANULAR_BITROUND case ('BITROUND') - list(n)%quantize_algorithm = MAPL_Quantize_BitRound + list(n)%quantize_algorithm = MAPL_QUANTIZE_BITROUND case default - _FAIL('Invalid quantize_algorithm. Allowed values are NONE, bitgroom, granular_bitround, granularbr (deprecated), and bitround') + _FAIL('Invalid quantize_algorithm. Allowed values are none, bitgroom, granular_bitround, granularbr (deprecated), and bitround') end select - call ESMF_ConfigGetAttribute ( cfg, list(n)%quantize_level, default=0, & - label=trim(string) // 'quantize_level:' ,_RC ) - ! If nbits_to_keep < MAPL_NBITS_UPPER_LIMIT (24) and quantize_algorithm greater than 0, then a user might be doing different ! shaving algorithms. We do not allow this - _ASSERT( .not. ( (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) .and. (list(n)%quantize_algorithm > 0) ), 'nbits < 24 and quantize_algorithm > 0 is not allowed. Choose one bit grooming method.') - - ! quantize_algorithm must be between 0 and 3 where 0 means not enabled - _ASSERT( (list(n)%quantize_algorithm >= 0) .and. (list(n)%quantize_algorithm <= 3), 'quantize_algorithm must be between 0 and 3, where 0 means not enabled') + _ASSERT( .not. ( (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) .and. (list(n)%quantize_algorithm > MAPL_NOQUANTIZE) ), 'nbits < 24 and quantize_algorithm not "none" is not allowed. Choose a supported quantization method.') ! Now we test in the case that a valid quantize algorithm is chosen - if (list(n)%quantize_algorithm == 0) then - ! If quantize_algorithm is 0, then quantize_level must be 0 - _ASSERT( list(n)%quantize_level == 0, 'quantize_algorithm is 0, so quantize_level must be 0') - else + if (list(n)%quantize_algorithm /= MAPL_NOQUANTIZE) then ! If quantize_algorithm is greater than 0, then quantize_level must be greater than or equal to 0 _ASSERT( list(n)%quantize_level >= 0, 'netCDF quantize has been enabled, so quantize_level must be greater than or equal to 0') end if diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index f1817666edfb..3b7e0f67dd5c 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -51,7 +51,7 @@ module MAPL_GriddedIOMod type(VerticalData) :: vdata type(GriddedIOitemVector) :: items integer :: deflateLevel = 0 - integer :: quantizeAlgorithm = 1 + integer :: quantizeAlgorithm = MAPL_NOQUANTIZE integer :: quantizeLevel = 0 integer, allocatable :: chunking(:) logical :: itemOrderAlphabetical = .true. @@ -60,6 +60,7 @@ module MAPL_GriddedIOMod contains procedure :: CreateFileMetaData procedure :: CreateVariable + procedure :: CreateQuantizationInfo procedure :: modifyTime procedure :: modifyTimeIncrement procedure :: bundlePost @@ -201,6 +202,12 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr _VERIFY(status) metadataVarsSize = order%size() + ! If quantize algorithm is set, create a quantization_info variable + if (this%quantizeAlgorithm /= MAPL_NOQUANTIZE) then + call this%CreateQuantizationInfo(rc=status) + _VERIFY(status) + end if + iter = this%items%begin() do while (iter /= this%items%end()) item => iter%get() @@ -424,23 +431,25 @@ subroutine CreateVariable(this,itemName,rc) #endif ! The CF Convention will soon support quantization. This requires three new attributes ! if enabled: - ! 1. quantization --> Will point to a quantization_info containter with the quantization algorithm + ! 1. quantization --> Will point to a quantization_info container with the quantization algorithm + ! (NOTE: this will need to be programmatic when per-variable quantization is enabled) ! 2a. quantization_nsb --> Number of significant bits (only for bitround) - ! 2b. quantization_nsd --> Number of significant digits (only for bitgroom and granular_bitgroom) - ! 3. quantization_maximum_relative_error --> Maximum relative error (defined as 2^(-nsb) for bitround, and UNDEFINED? for bitgroom and granular_bitgroom) + ! 2b. quantization_nsd --> Number of significant digits (only for bitgroom and granular_bitround) + ! 3. quantization_maximum_relative_error --> Maximum relative error (defined as 2^(-nsb) for bitround, and UNDEFINED? for bitgroom and granular_bitround) - ! Bitround ==> 1 - if (this%quantizeAlgorithm == 1) then + ! Bitround + if (this%quantizeAlgorithm == MAPL_QUANTIZE_BITROUND) then call v%add_attribute('quantization', 'quantization_info') call v%add_attribute('quantization_nsb', this%quantizeLevel) call v%add_attribute('quantization_maximum_relative_error', 0.5 * 2.0**(-this%quantizeLevel)) end if - ! granular_bitgroom ==> 2, bitgroom ==> 3 - if (this%quantizeAlgorithm == 2 .or. this%quantizeAlgorithm == 3) then + ! granular_bitround and bitgroom + if (this%quantizeAlgorithm == MAPL_QUANTIZE_BITGROOM .or. this%quantizeAlgorithm == MAPL_QUANTIZE_GRANULAR_BITROUND) then call v%add_attribute('quantization', 'quantization_info') call v%add_attribute('quantization_nsd', this%quantizeLevel) ! For now, don't add this until we know what to do - !call v%add_attribute('quantization_maximum_relative_error', 0.5 * 2.0**(-this%quantizeLevel)) + ! Add something for testing + call v%add_attribute('quantization_maximum_relative_error', 0.5 * 10.0**(-this%quantizeLevel)) end if call factory%append_variable_metadata(v) @@ -462,6 +471,54 @@ subroutine CreateVariable(this,itemName,rc) end subroutine CreateVariable + subroutine CreateQuantizationInfo(this,rc) + class (MAPL_GriddedIO), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + class (AbstractGridFactory), pointer :: factory + character(len=:), allocatable :: varName + type(Variable) :: v + + factory => get_factory(this%output_grid,rc=status) + _VERIFY(status) + + v = Variable(type=PFIO_CHAR) + + ! In the future when we can do per variable quantization, we will need + ! to do things like quantization_info1, quantization_info2, etc. + ! For now, we will just use quantization_info as it is per collection + varName = "quantization_info" + + ! We need to convert the quantization algorithm to a string + select case (this%quantizeAlgorithm) + case (MAPL_QUANTIZE_BITGROOM) + call v%add_attribute('algorithm', 'bitgroom') + case (MAPL_QUANTIZE_BITROUND) + call v%add_attribute('algorithm', 'bitround') + case (MAPL_QUANTIZE_GRANULAR_BITROUND) + call v%add_attribute('algorithm', 'granular_bitround') + case default + _FAIL('Unknown quantization algorithm') + end select + + ! Next add the implementation details + ! 3. implementation: This property contains free-form text + ! that concisely conveys the algorithm provenance, including the + ! name of the library or client that performed the quantization, + ! the software version, and the name of the author(s) if deemed + ! relevant. + call v%add_attribute('implementation', 'MAPL') + + call factory%append_variable_metadata(v) + call this%metadata%add_variable(trim(varName),v,rc=status) + _VERIFY(status) + + _RETURN(_SUCCESS) + + end subroutine CreateQuantizationInfo + subroutine modifyTime(this, oClients, rc) class(MAPL_GriddedIO), intent(inout) :: this type (ClientManager), optional, intent(inout) :: oClients diff --git a/pfio/Variable.F90 b/pfio/Variable.F90 index 67344a40fa5b..624954bfd162 100644 --- a/pfio/Variable.F90 +++ b/pfio/Variable.F90 @@ -28,7 +28,7 @@ module pFIO_VariableMod type (StringAttributeMap) :: attributes type (UnlimitedEntity) :: const_value integer :: deflation = 0 ! default no compression - integer :: quantize_algorithm = 0 ! default no quantize_algorithm + integer :: quantize_algorithm = 0 ! default no quantization integer :: quantize_level = 0 ! default no quantize_level integer, allocatable :: chunksizes(:) contains diff --git a/shared/Constants/InternalConstants.F90 b/shared/Constants/InternalConstants.F90 index 57a8c8eda94b..f2cae5cf9cb6 100644 --- a/shared/Constants/InternalConstants.F90 +++ b/shared/Constants/InternalConstants.F90 @@ -166,12 +166,12 @@ module MAPL_InternalConstantsMod integer, parameter :: MAPL_NBITS_NOT_SET = 1000 integer, parameter :: MAPL_NBITS_UPPER_LIMIT = 24 - ! Constants for netCDF quantize + ! Constants for netCDF quantize (these echo the values in the netcdf-fortran library) enum, bind(c) - enumerator MAPL_Quantize_Disabled - enumerator MAPL_Quantize_BitGroom - enumerator MAPL_Quantize_Granular_BitRound - enumerator MAPL_Quantize_BitRound + enumerator MAPL_NOQUANTIZE + enumerator MAPL_QUANTIZE_BITGROOM + enumerator MAPL_QUANTIZE_GRANULAR_BITROUND + enumerator MAPL_QUANTIZE_BITROUND endenum ! Constant masking enum, bind(c) From 2345b5b5c7005e3858a486dbdf2a531a4269387a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 1 Aug 2024 11:46:26 -0400 Subject: [PATCH 35/77] More updates --- gridcomps/History/MAPL_HistoryGridComp.F90 | 11 ++++++ griddedio/GriddedIO.F90 | 46 +++++++++++++++++++--- 2 files changed, 52 insertions(+), 5 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index f86135d6880e..da35528dd3d4 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -870,6 +870,17 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _ASSERT( list(n)%quantize_level >= 0, 'netCDF quantize has been enabled, so quantize_level must be greater than or equal to 0') end if + ! If a user has chosen MAPL_QUANTIZE_BITROUND, then we allow a maximum of 23 bits to be kept + if (list(n)%quantize_algorithm == MAPL_QUANTIZE_BITROUND) then + _ASSERT( list(n)%quantize_level <= 23, 'netCDF bitround has been enabled, so number of significant bits (quantize_level) must be less than or equal to 23') + end if + + ! For MAPL_QUANTIZE_GRANULAR_BITROUND and MAPL_QUANTIZE_BITGROOM, these use number of + ! significant digits, so for single precision, we allow a maximum of 7 digits to be kept + if (list(n)%quantize_algorithm == MAPL_QUANTIZE_GRANULAR_BITROUND .or. list(n)%quantize_algorithm == MAPL_QUANTIZE_BITGROOM) then + _ASSERT( list(n)%quantize_level <= 7, 'netCDF granular bitround or bitgroom has been enabled, so number of significant digits (quantize_level) must be less than or equal to 7') + end if + tm_default = -1 call ESMF_ConfigGetAttribute ( cfg, list(n)%tm, default=tm_default, & label=trim(string) // 'tm:', _RC ) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 3b7e0f67dd5c..3239fa367e19 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -26,6 +26,7 @@ module MAPL_GriddedIOMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL64 use ieee_arithmetic, only: isnan => ieee_is_nan + use netcdf, only: nf90_inq_libvers implicit none private @@ -447,9 +448,11 @@ subroutine CreateVariable(this,itemName,rc) if (this%quantizeAlgorithm == MAPL_QUANTIZE_BITGROOM .or. this%quantizeAlgorithm == MAPL_QUANTIZE_GRANULAR_BITROUND) then call v%add_attribute('quantization', 'quantization_info') call v%add_attribute('quantization_nsd', this%quantizeLevel) - ! For now, don't add this until we know what to do - ! Add something for testing - call v%add_attribute('quantization_maximum_relative_error', 0.5 * 10.0**(-this%quantizeLevel)) + ! Per czender, these have maximum_absolute_error. We use the calculate_mae function below + ! which replicates a table in doi:10.5194/gmd-12-4099-2019 + ! NOTE: This might not be the right formula. As the CF Convention draft is updated, + ! we will update this code. + call v%add_attribute('quantization_maximum_absolute_error', calculate_mae(this%quantizeLevel)) end if call factory%append_variable_metadata(v) @@ -471,6 +474,30 @@ subroutine CreateVariable(this,itemName,rc) end subroutine CreateVariable + function calculate_mae(nsd) result(mae) + + ! This function is based on Table 3 of doi:10.5194/gmd-12-4099-2019 + ! The algorithm is weird, but it does duplicate the table + + implicit none + integer, intent(in) :: nsd + real(kind=REAL32) :: mae + real(kind=REAL32) :: mae_base + integer :: correction + + mae_base = 4.0 * (1.0/16.0)**floor(real(nsd)/2.0) * (1.0/8.0)**ceiling(real(nsd)/2.0) + + if (nsd > 2 .and. mod(nsd, 2) == 0) then + correction = 2 + else if (nsd == 7) then + correction = 2 + else + correction = 1 + end if + + mae = mae_base * correction + end function calculate_mae + subroutine CreateQuantizationInfo(this,rc) class (MAPL_GriddedIO), intent(inout) :: this integer, optional, intent(out) :: rc @@ -478,7 +505,7 @@ subroutine CreateQuantizationInfo(this,rc) integer :: status class (AbstractGridFactory), pointer :: factory - character(len=:), allocatable :: varName + character(len=:), allocatable :: varName, netcdf_version type(Variable) :: v factory => get_factory(this%output_grid,rc=status) @@ -509,7 +536,16 @@ subroutine CreateQuantizationInfo(this,rc) ! name of the library or client that performed the quantization, ! the software version, and the name of the author(s) if deemed ! relevant. - call v%add_attribute('implementation', 'MAPL') + ! + ! In the current case, all algorithms are from libnetcdf + ! we make a string using nf90_inq_libvers() + + netcdf_version = 'libnetcdf ' // nf90_inq_libvers() + call v%add_attribute('implementation', netcdf_version) + + ! NOTE: In the future if we add the MAPL bit-shaving + ! to use the quantization parts of the code, it will + ! need a different implementation string call factory%append_variable_metadata(v) call this%metadata%add_variable(trim(varName),v,rc=status) From e47dc197830b58ae08e9db2fb535d7d802b0e1ec Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 1 Aug 2024 11:51:14 -0400 Subject: [PATCH 36/77] Make the DOI's less URL like --- griddedio/GriddedIO.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 3239fa367e19..4a27dbe113c7 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -449,7 +449,7 @@ subroutine CreateVariable(this,itemName,rc) call v%add_attribute('quantization', 'quantization_info') call v%add_attribute('quantization_nsd', this%quantizeLevel) ! Per czender, these have maximum_absolute_error. We use the calculate_mae function below - ! which replicates a table in doi:10.5194/gmd-12-4099-2019 + ! which replicates a table in doi 10.5194/gmd-12-4099-2019 ! NOTE: This might not be the right formula. As the CF Convention draft is updated, ! we will update this code. call v%add_attribute('quantization_maximum_absolute_error', calculate_mae(this%quantizeLevel)) @@ -476,7 +476,7 @@ end subroutine CreateVariable function calculate_mae(nsd) result(mae) - ! This function is based on Table 3 of doi:10.5194/gmd-12-4099-2019 + ! This function is based on Table 3 of doi 10.5194/gmd-12-4099-2019 ! The algorithm is weird, but it does duplicate the table implicit none From 84fb0ff6e34bbd68300a1039208f9fc52eca8479 Mon Sep 17 00:00:00 2001 From: Matt Thompson Date: Thu, 1 Aug 2024 12:11:12 -0400 Subject: [PATCH 37/77] Update griddedio/GriddedIO.F90 Co-authored-by: Tom Clune --- griddedio/GriddedIO.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 4a27dbe113c7..f39906f6c23b 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -479,7 +479,6 @@ function calculate_mae(nsd) result(mae) ! This function is based on Table 3 of doi 10.5194/gmd-12-4099-2019 ! The algorithm is weird, but it does duplicate the table - implicit none integer, intent(in) :: nsd real(kind=REAL32) :: mae real(kind=REAL32) :: mae_base From 175b0e676b45eec098c374bf43e5f18c747d492a Mon Sep 17 00:00:00 2001 From: Matt Thompson Date: Thu, 1 Aug 2024 12:11:33 -0400 Subject: [PATCH 38/77] Update griddedio/GriddedIO.F90 Co-authored-by: Tom Clune --- griddedio/GriddedIO.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index f39906f6c23b..fb739083427c 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -547,8 +547,7 @@ subroutine CreateQuantizationInfo(this,rc) ! need a different implementation string call factory%append_variable_metadata(v) - call this%metadata%add_variable(trim(varName),v,rc=status) - _VERIFY(status) + call this%metadata%add_variable(trim(varName),v,_RC) _RETURN(_SUCCESS) From fed3655dfac38f9ecb874aa094915897254c17d2 Mon Sep 17 00:00:00 2001 From: Matt Thompson Date: Thu, 1 Aug 2024 12:11:44 -0400 Subject: [PATCH 39/77] Update griddedio/GriddedIO.F90 Co-authored-by: Tom Clune --- griddedio/GriddedIO.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index fb739083427c..e34d8a00d9a1 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -507,8 +507,7 @@ subroutine CreateQuantizationInfo(this,rc) character(len=:), allocatable :: varName, netcdf_version type(Variable) :: v - factory => get_factory(this%output_grid,rc=status) - _VERIFY(status) + factory => get_factory(this%output_grid,_RC) v = Variable(type=PFIO_CHAR) From 54aea8745663300275706e26034928c0592d353b Mon Sep 17 00:00:00 2001 From: Matt Thompson Date: Thu, 1 Aug 2024 12:11:51 -0400 Subject: [PATCH 40/77] Update griddedio/GriddedIO.F90 Co-authored-by: Tom Clune --- griddedio/GriddedIO.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index e34d8a00d9a1..bc6351daee10 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -205,8 +205,7 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr ! If quantize algorithm is set, create a quantization_info variable if (this%quantizeAlgorithm /= MAPL_NOQUANTIZE) then - call this%CreateQuantizationInfo(rc=status) - _VERIFY(status) + call this%CreateQuantizationInfo(_RC) end if iter = this%items%begin() From d26d17f5355f23f2cdbf76a7da2231f0efc5d5bb Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 1 Aug 2024 13:14:28 -0400 Subject: [PATCH 41/77] Fix typo --- gridcomps/History/MAPL_HistoryGridComp.F90 | 7 +++++-- griddedio/GriddedIO.F90 | 7 ++----- shared/Constants/InternalConstants.F90 | 4 ++++ 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index da35528dd3d4..7aa0afff2a1c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -425,6 +425,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) logical :: has_conservative_keyword, has_regrid_keyword integer :: create_mode character(len=:), allocatable :: uppercase_algorithm + character(len=2) :: tmpchar ! Begin !------ @@ -872,13 +873,15 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! If a user has chosen MAPL_QUANTIZE_BITROUND, then we allow a maximum of 23 bits to be kept if (list(n)%quantize_algorithm == MAPL_QUANTIZE_BITROUND) then - _ASSERT( list(n)%quantize_level <= 23, 'netCDF bitround has been enabled, so number of significant bits (quantize_level) must be less than or equal to 23') + write(tmpchar, '(I2)') MAPL_QUANTIZE_MAX_NSB + _ASSERT( list(n)%quantize_level <= MAPL_QUANTIZE_MAX_NSB, 'netCDF bitround has been enabled, so number of significant bits (quantize_level) must be less than or equal to ' // trim(tmpchar)) end if ! For MAPL_QUANTIZE_GRANULAR_BITROUND and MAPL_QUANTIZE_BITGROOM, these use number of ! significant digits, so for single precision, we allow a maximum of 7 digits to be kept if (list(n)%quantize_algorithm == MAPL_QUANTIZE_GRANULAR_BITROUND .or. list(n)%quantize_algorithm == MAPL_QUANTIZE_BITGROOM) then - _ASSERT( list(n)%quantize_level <= 7, 'netCDF granular bitround or bitgroom has been enabled, so number of significant digits (quantize_level) must be less than or equal to 7') + write(tmpchar, '(I2)') MAPL_QUANTIZE_MAX_NSD + _ASSERT( list(n)%quantize_level <= MAPL_QUANTIZE_MAX_NSD, 'netCDF granular bitround or bitgroom has been enabled, so number of significant digits (quantize_level) must be less than or equal to ' // trim(tmpchar)) end if tm_default = -1 diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index bc6351daee10..7eb3cf53c7f7 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -485,12 +485,9 @@ function calculate_mae(nsd) result(mae) mae_base = 4.0 * (1.0/16.0)**floor(real(nsd)/2.0) * (1.0/8.0)**ceiling(real(nsd)/2.0) - if (nsd > 2 .and. mod(nsd, 2) == 0) then + correction = 1 + if ( (nsd > 2 .and. mod(nsd, 2) == 0) .or. nsd == 7 ) then correction = 2 - else if (nsd == 7) then - correction = 2 - else - correction = 1 end if mae = mae_base * correction diff --git a/shared/Constants/InternalConstants.F90 b/shared/Constants/InternalConstants.F90 index f2cae5cf9cb6..3cad2914e86f 100644 --- a/shared/Constants/InternalConstants.F90 +++ b/shared/Constants/InternalConstants.F90 @@ -173,6 +173,10 @@ module MAPL_InternalConstantsMod enumerator MAPL_QUANTIZE_GRANULAR_BITROUND enumerator MAPL_QUANTIZE_BITROUND endenum + ! Maximum number of significant digits for quantization (bitgroom, granular_bitround) + integer, parameter :: MAPL_QUANTIZE_MAX_NSD = 7 + ! Maximum number of significant bits for quantization (bitround) + integer, parameter :: MAPL_QUANTIZE_MAX_NSB = 23 ! Constant masking enum, bind(c) enumerator MAPL_MASK_OUT From 40113b5a7dc833a6e71633c15945ecb4820449b8 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 1 Aug 2024 15:02:33 -0400 Subject: [PATCH 42/77] Update to ESMA_cmake v3.49.0 --- CHANGELOG.md | 3 ++- components.yaml | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 49bcd6b07ed0..559b047b8f27 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -32,9 +32,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops - Move to GEOSpyD Min24.4.4 Python 3.11 - - ESMA_cmake v3.48.0 + - ESMA_cmake v3.49.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs + - Add SMOD to submodule generator ### Fixed diff --git a/components.yaml b/components.yaml index 21a9ab4486f8..897a4407432e 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.48.0 + tag: v3.49.0 develop: develop ecbuild: From 5e935ec62e0a15182e6c69576688b14fa8f97a3e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 5 Aug 2024 09:41:08 -0400 Subject: [PATCH 43/77] Fix GCC 14 issue with profiler test --- CHANGELOG.md | 2 ++ profiler/tests/test_PercentageColumn.pf | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 559b047b8f27..1b3693b0ca21 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -39,6 +39,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fix profiler PercentageColumn test for GCC 14 + ### Removed ### Deprecated diff --git a/profiler/tests/test_PercentageColumn.pf b/profiler/tests/test_PercentageColumn.pf index 2d3047938346..39d7368e86ee 100644 --- a/profiler/tests/test_PercentageColumn.pf +++ b/profiler/tests/test_PercentageColumn.pf @@ -13,10 +13,10 @@ contains type (MeterNode), target :: node class (AbstractMeterNode), pointer :: child class (AbstractMeter), pointer :: t - type(UnlimitedVector) :: v + type(UnlimitedVector), target :: v integer :: i integer :: expected(2) - class(*), allocatable :: q + class(*), pointer :: q node = MeterNode('foo', AdvancedMeter(MpiTimerGauge())) t => node%get_meter() @@ -26,19 +26,19 @@ contains child => node%get_child('a') t => child%get_meter() call t%add_cycle(5.0_REAL64) - + c = PercentageColumn(InclusiveColumn(),'MAX') v = c%get_rows(node) expected = [100.,50.] do i = 1, 2 - q = v%at(i) + q => v%at(i) select type (q) type is (real(kind=REAL64)) @assertEqual(expected(i), q) end select end do - + end subroutine test_percent_inclusive end module test_PercentageColumn From 6896b82f3fe40ca350e30c5fc299637bd55f5623 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 5 Aug 2024 11:49:57 -0400 Subject: [PATCH 44/77] Fix bug in CMake for ExtData2G Tests --- CHANGELOG.md | 1 + Tests/ExtData_Testing_Framework/CMakeLists.txt | 3 +-- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1b3693b0ca21..66ba3617fe56 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -40,6 +40,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fix profiler PercentageColumn test for GCC 14 +- Fix bug in ExtData Tests. CMake was overwriting the `EXTDATA2G_SMALL_TESTS` LABEL with `ESSENTIAL` ### Removed diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index 507ff970b7fe..283e53bea457 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -73,7 +73,6 @@ foreach(TEST_CASE ${TEST_CASES_2G}) 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_SMALL_TESTS") - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "ESSENTIAL") + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS;ESSENTIAL") endif() endforeach() From 11093b966f8a2058cae2e6b5837972f0819adfcb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 5 Aug 2024 13:05:13 -0400 Subject: [PATCH 45/77] some prep work for extdata2g vertical regridding development --- Tests/CMakeLists.txt | 8 + Tests/CapDriver.F90 | 24 ++ gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 319 +++++++--------------- 3 files changed, 138 insertions(+), 213 deletions(-) create mode 100644 Tests/CapDriver.F90 diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index ebb0dcb2122d..dd1bf25c4bba 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -35,4 +35,12 @@ if (BUILD_WITH_FARGPARSE) endif () set_target_properties(MAPL_demo_fargparse.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + ecbuild_add_executable (TARGET CapDriver.x SOURCES CapDriver.F90 ExtDataRoot_GridComp.F90 VarspecDescription.F90) + target_link_libraries (CapDriver.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) + # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 + if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") + target_link_libraries(CapDriver.x PRIVATE OpenMP::OpenMP_Fortran) + endif () + set_target_properties(CapDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + endif () diff --git a/Tests/CapDriver.F90 b/Tests/CapDriver.F90 new file mode 100644 index 000000000000..cadc059779da --- /dev/null +++ b/Tests/CapDriver.F90 @@ -0,0 +1,24 @@ +#define I_AM_MAIN + +#include "MAPL_Generic.h" + +program CapDriver_Main + use MPI + use MAPL + use ExtDataUtRoot_GridCompMod, only: ROOT_SetServices => SetServices + implicit none + + character(len=*), parameter :: Iam="CapDriver_Main" + type (MAPL_Cap) :: cap + type (MAPL_FargparseCLI) :: cli + type (MAPL_CapOptions) :: cap_options + integer :: status + + cli = MAPL_FargparseCLI() + cap_options = MAPL_CapOptions(cli) + cap = MAPL_Cap('Root', ROOT_SetServices, cap_options = cap_options) + + call cap%run(_RC) + +end program CapDriver_Main + diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 44877d8f1552..96797303554f 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -147,8 +147,7 @@ SUBROUTINE SetServices ( GC, RC ) ! Wrap internal state for storing in GC; rename legacyState ! ------------------------------------- - allocate ( self, stat=STATUS ) - _VERIFY(STATUS) + allocate ( self, _STAT ) wrap%ptr => self ! ------------------------ @@ -164,48 +163,27 @@ SUBROUTINE SetServices ( GC, RC ) ! Store internal state in GC ! -------------------------- call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) - _VERIFY(STATUS) - - call MAPL_TimerAdd(gc,name="Initialize", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="Run", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="-Read_Loop", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--CheckUpd", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Read", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--GridCreate", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--IclientWait", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--PRead", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---CreateCFIO", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---prefetch", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----add-collection", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----make-reference", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----RegridStore", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----request", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---IclientDone", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="----RegridApply", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="---read-prefetch", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Swap", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="--Bracket", rc=status) - _VERIFY(STATUS) - call MAPL_TimerAdd(gc,name="-Interpolate", rc=status) - _VERIFY(STATUS) + + call MAPL_TimerAdd(gc,name="Initialize", _RC) + call MAPL_TimerAdd(gc,name="Run", _RC) + call MAPL_TimerAdd(gc,name="-Read_Loop", _RC) + call MAPL_TimerAdd(gc,name="--CheckUpd", _RC) + call MAPL_TimerAdd(gc,name="--Read", _RC) + call MAPL_TimerAdd(gc,name="--GridCreate", _RC) + call MAPL_TimerAdd(gc,name="--IclientWait", _RC) + call MAPL_TimerAdd(gc,name="--PRead", _RC) + call MAPL_TimerAdd(gc,name="---CreateCFIO", _RC) + call MAPL_TimerAdd(gc,name="---prefetch", _RC) + call MAPL_TimerAdd(gc,name="----add-collection", _RC) + call MAPL_TimerAdd(gc,name="----make-reference", _RC) + call MAPL_TimerAdd(gc,name="----RegridStore", _RC) + call MAPL_TimerAdd(gc,name="----request", _RC) + call MAPL_TimerAdd(gc,name="---IclientDone", _RC) + call MAPL_TimerAdd(gc,name="----RegridApply", _RC) + call MAPL_TimerAdd(gc,name="---read-prefetch", _RC) + call MAPL_TimerAdd(gc,name="--Swap", _RC) + call MAPL_TimerAdd(gc,name="--Bracket", _RC) + call MAPL_TimerAdd(gc,name="-Interpolate", _RC) ! Generic Set Services ! -------------------- call MAPL_GenericSetServices ( GC, _RC ) @@ -284,8 +262,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Start Some Timers ! ----------------- - call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, _RC) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Initialize") @@ -295,8 +272,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ClockGet(CLOCK, currTIME=time, _RC) ! Get information from export state !---------------------------------- - call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, _RC) ! no need to run ExtData if there are no imports to fill if (ItemCount == 0) then @@ -311,14 +287,10 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call new_ExtDataOldTypesCreator(config_yaml, new_rc_file, time, _RC) - allocate(ITEMNAMES(ITEMCOUNT), STAT=STATUS) - _VERIFY(STATUS) - allocate(ITEMTYPES(ITEMCOUNT), STAT=STATUS) - _VERIFY(STATUS) + allocate(ITEMNAMES(ITEMCOUNT), _STAT) + allocate(ITEMTYPES(ITEMCOUNT), _STAT) - call ESMF_StateGet(EXPORT, ITEMNAMELIST=ITEMNAMES, & - ITEMTYPELIST=ITEMTYPES, RC=STATUS) - _VERIFY(STATUS) + call ESMF_StateGet(EXPORT, ITEMNAMELIST=ITEMNAMES, ITEMTYPELIST=ITEMTYPES, _RC) ! -------- ! Initialize MAPL Generic @@ -334,8 +306,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primaryitemcount=0 deriveditemcount=0 do i=1,size(itemnames) - item_type = config_yaml%get_item_type(trim(itemnames(i)),rc=status) - _VERIFY(status) + item_type = config_yaml%get_item_type(trim(itemnames(i)), _RC) found_in_config = (item_type/= ExtData_not_found) if (.not.found_in_config) call unsatisfied_imports%push_back(itemnames(i)) if (item_type == derived_type) then @@ -388,7 +359,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do j=1,num_rules num_primary=num_primary+1 write(sidx,'(I1)')j - call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,rc=status) + call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,_RC) _ASSERT(status==0, "ExtData multi-rule problem with BASE NAME "//TRIM(current_base_name)) allocate(self%primary%item(num_primary)%start_end_time(2)) self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) @@ -396,7 +367,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) enddo else num_primary=num_primary+1 - call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,rc=status) + call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,_RC) _ASSERT(status==0, "ExtData single-rule problem with BASE NAME "//TRIM(current_base_name)) end if call ESMF_StateGet(Export,current_base_name,state_item_type,_RC) @@ -439,7 +410,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !end if !enddo !_ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') - !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) + !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,_RC) !_ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') !end if @@ -533,8 +504,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _RETURN(ESMF_SUCCESS) end if - call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, _RC) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Run") @@ -543,11 +513,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Fill in the internal state with data from the files ! --------------------------------------------------- - allocate(do_pointer_update(self%primary%nitems),stat=status) - _VERIFY(STATUS) + allocate(do_pointer_update(self%primary%nitems),_STAT) do_pointer_update = .false. - allocate(useTime(self%primary%nitems),stat=status) - _VERIFY(STATUS) + allocate(useTime(self%primary%nitems),_STAT) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") @@ -607,36 +575,29 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) file_Processed = io_bundle%file_name item => self%primary%item(entry_num) - io_bundle%pbundle = ESMF_FieldBundleCreate(rc=status) - _VERIFY(STATUS) + io_bundle%pbundle = ESMF_FieldBundleCreate(_RC) - call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,rc=status) - _VERIFY(status) + call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,_RC) call bundle_iter%next() enddo call MAPL_TimerOn(MAPLSTATE,"--PRead") call MAPL_TimerOn(MAPLSTATE,"---CreateCFIO") - call MAPL_ExtDataCreateCFIO(IOBundles, rc=status) - _VERIFY(status) + call MAPL_ExtDataCreateCFIO(IOBundles, _RC) call MAPL_TimerOff(MAPLSTATE,"---CreateCFIO") call MAPL_TimerOn(MAPLSTATE,"---prefetch") - call MAPL_ExtDataPrefetch(IOBundles, file_weights=self%file_weights, rc=status) - _VERIFY(status) + call MAPL_ExtDataPrefetch(IOBundles, file_weights=self%file_weights, _RC) call MAPL_TimerOff(MAPLSTATE,"---prefetch") - _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"---IclientDone") call i_Clients%done_collective_prefetch() call i_Clients%wait() call MAPL_TimerOff(MAPLSTATE,"---IclientDone") - _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") - call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) - _VERIFY(status) + call MAPL_ExtDataReadPrefetch(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") @@ -646,12 +607,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) bracket_side = io_bundle%bracket_side entry_num = io_bundle%entry_index item => self%primary%item(entry_num) - call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,rc=status) - _VERIFY(status) + call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) call bundle_iter%next() enddo - call MAPL_ExtDataDestroyCFIO(IOBundles,rc=status) - _VERIFY(status) + call MAPL_ExtDataDestroyCFIO(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") @@ -789,7 +748,6 @@ subroutine extract_ ( GC, self, CF, rc) ! Get my internal state ! --------------------- call ESMF_UserCompGetInternalState(gc, 'MAPL_ExtData_state', WRAP, STATUS) - _VERIFY(STATUS) self => wrap%ptr ! Get the configuration @@ -857,8 +815,7 @@ subroutine GetLevs(item, rc) _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file_template)) end if - levName = item%file_metadata%get_level_name(rc=status) - _VERIFY(status) + levName = item%file_metadata%get_level_name(_RC) if (trim(levName) /='') then call item%file_metadata%get_coordinate_info(levName,coordSize=item%lm,coordUnits=tLevUnits,coords=levFile,_RC) levUnits=MAPL_TrimString(tlevUnits) @@ -885,11 +842,9 @@ subroutine GetLevs(item, rc) end if if (trim(item%levunit)=='hpa') item%levs=item%levs*100.0 if (item%isVector) then - item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",rc=status) - _VERIFY(status) + item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",_RC) else - item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",rc=status) - _VERIFY(status) + item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",_RC) end if else @@ -931,66 +886,44 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) if (item%do_VertInterp) then if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,rc=status) - _VERIFY(status) + call MAPL_ExtDataFlipVertical(item,filec,_RC) end if if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) else if (item%vartype == MAPL_VectorField) then id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) - _VERIFY(STATUS) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) end if else if (item%do_Fill) then if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) else if (item%vartype == MAPL_VectorField) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) - _VERIFY(STATUS) - call MAPL_ExtDataFillField(item,field,newfield,rc=status) - _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) end if else if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,rc=status) - _VERIFY(status) + call MAPL_ExtDataFlipVertical(item,filec,_RC) end if end if @@ -1022,65 +955,41 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) call ESMF_ConfigGetAttribute(CF, value = NY, Label="NY:", _RC) comp_name = "ExtData" - cflocal = MAPL_ConfigCreate(rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",rc=status) - _VERIFY(status) + cflocal = MAPL_ConfigCreate(_RC) + call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",_RC) if (counts(2) == 6*counts(1)) then - call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) - _VERIFY(status) - - call ESMF_InfoGetFromHost(grid,infoh,rc=status) - _VERIFY(status) - isPresent = ESMF_InfoIsPresent(infoh,'STRETCH_FACTOR',rc=status) - _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",_RC) + + call ESMF_InfoGetFromHost(grid,infoh,_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'STRETCH_FACTOR',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'STRETCH_FACTOR',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",_RC) endif - isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LON',rc=status) - _VERIFY(status) + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LON',_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'TARGET_LON',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'TARGET_LON',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",_RC) endif - isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LAT',rc=status) - _VERIFY(status) + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LAT',_RC) if (isPresent) then - call ESMF_InfoGet(infoh,'TARGET_LAT',temp_real,rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) - _VERIFY(status) + call ESMF_InfoGet(infoh,'TARGET_LAT',temp_real,_RC) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",_RC) endif else - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) - _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) - _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",_RC) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",_RC) end if - newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", rc=status) - _VERIFY(status) + newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", _RC) _RETURN(ESMF_SUCCESS) @@ -1196,10 +1105,8 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) real, pointer :: ptrF(:,:,:),ptrR(:,:,:) integer :: lm_in,lm_out,i - call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,rc=status) - _VERIFY(STATUS) - call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,_RC) + call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,_RC) ptrF = 0.0 lm_in= size(ptrR,3) lm_out = size(ptrF,3) @@ -1252,16 +1159,13 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) end if - call ESMF_FieldGet(Field1,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) - allocate(ptemp,source=ptr,stat=status) - _VERIFY(status) + call ESMF_FieldGet(Field1,0,farrayPtr=ptr,_RC) + allocate(ptemp,source=ptr,_STAT) ls = lbound(ptr,3) le = ubound(ptr,3) ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) - call ESMF_FieldGet(Field2,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field2,0,farrayPtr=ptr,_RC) ptemp=ptr ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) @@ -1275,10 +1179,8 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) end if - call ESMF_FieldGet(Field,0,farrayPtr=ptr,rc=status) - _VERIFY(STATUS) - allocate(ptemp,source=ptr,stat=status) - _VERIFY(status) + call ESMF_FieldGet(Field,0,farrayPtr=ptr,_RC) + allocate(ptemp,source=ptr,_STAT) ls = lbound(ptr,3) le = ubound(ptr,3) ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) @@ -1309,14 +1211,10 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) end if - call ESMF_FieldGet(Field1,grid=grid,rc=status) - _VERIFY(STATUS) - call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field1,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field2,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field1,grid=grid,_RC) + call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) + call MAPL_FieldBundleAdd(pbundle,Field1,_RC) + call MAPL_FieldBundleAdd(pbundle,Field2,_RC) else @@ -1326,12 +1224,9 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) end if - call ESMF_FieldGet(Field,grid=grid,rc=status) - _VERIFY(STATUS) - call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) - _VERIFY(STATUS) - call MAPL_FieldBundleAdd(pbundle,Field,rc=status) - _VERIFY(STATUS) + call ESMF_FieldGet(Field,grid=grid,_RC) + call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) + call MAPL_FieldBundleAdd(pbundle,Field,_RC) end if @@ -1480,8 +1375,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) if (trim(current_file)/=file_not_found) then call itemsL%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsL,on_tiles,rc=status) - _VERIFY(status) + item%pfioCollection_id,item%iclient_collection_id,itemsL,on_tiles,_RC) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated L bracket with: %a at time index %i3 ',item%name, current_file, time_index) end if @@ -1491,8 +1385,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) if (trim(current_file)/=file_not_found) then call itemsR%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsR,on_tiles,rc=status) - _VERIFY(status) + item%pfioCollection_id,item%iclient_collection_id,itemsR,on_tiles,_RC) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated R bracket with: %a at time index %i3 ',item%name,current_file, time_index) end if @@ -1680,7 +1573,7 @@ subroutine create_primary_field(item,ExtDataState,current_time,rc) logical :: file_found call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) - call ESMF_FieldValidate(field,rc=status) + call ESMF_FieldValidate(field,_RC) call ESMF_AttributeGet(field,name="derived_source",isPresent=must_create,_RC) if (.not.must_create) then _RETURN(_SUCCESS) From 11cc7dd2715e3bf36fb33ab90b539753a28bc22f Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 5 Aug 2024 13:16:51 -0400 Subject: [PATCH 46/77] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1b3693b0ca21..9e0a1c4efa53 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x - Added Fortran interface to UDUNITS2 - NOTE: This now means MAPL depends on UDUNITS2 (and transitively, expat) - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) From 09fababbd8b264e518cd2b50df75a2de61beabec Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 5 Aug 2024 15:09:10 -0400 Subject: [PATCH 47/77] see if this fixes CI --- Tests/CMakeLists.txt | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index dd1bf25c4bba..6445f710dc33 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -1,17 +1,18 @@ +esma_set_this (OVERRIDE MAPL.test_utilities) + set(MODULE_DIRECTORY "${esma_include}/Tests") set (srcs - ExtDataDriverGridComp.F90 ExtDataRoot_GridComp.F90 - ExtDataDriver.F90 - ExtDataDriverMod.F90 VarspecDescription.F90 ) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) + if (BUILD_WITH_FARGPARSE) - ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ${srcs}) - target_link_libraries (ExtDataDriver.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) + ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ExtDataDriver.F90 ExtDataDriverGridComp.F90 ExtDataDriverMod.F90) + target_link_libraries (ExtDataDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) @@ -35,8 +36,8 @@ if (BUILD_WITH_FARGPARSE) endif () set_target_properties(MAPL_demo_fargparse.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - ecbuild_add_executable (TARGET CapDriver.x SOURCES CapDriver.F90 ExtDataRoot_GridComp.F90 VarspecDescription.F90) - target_link_libraries (CapDriver.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) + ecbuild_add_executable (TARGET CapDriver.x SOURCES CapDriver.F90) + target_link_libraries (CapDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(CapDriver.x PRIVATE OpenMP::OpenMP_Fortran) From d569d2439b2db45068c04c0bf4be108f98990620 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 6 Aug 2024 10:06:27 -0400 Subject: [PATCH 48/77] connect exports of model to extdata --- gridcomps/Cap/MAPL_CapGridComp.F90 | 709 +++++++++++------------------ 1 file changed, 256 insertions(+), 453 deletions(-) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 7025bf8035a4..cf3e385e29e2 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -229,20 +229,16 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - call MAPL_InternalStateRetrieve(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_InternalStateRetrieve(gc, maplobj, _RC) t_p => get_global_time_profiler() - call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) - _VERIFY(status) - call ESMF_VMGet(cap%vm, petcount = NPES, mpiCommunicator = comm, rc = status) - _VERIFY(status) + call ESMF_GridCompGet(gc, vm = cap%vm, _RC) + call ESMF_VMGet(cap%vm, petcount = NPES, mpiCommunicator = comm, _RC) AmIRoot_ = MAPL_Am_I_Root(cap%vm) - call MAPL_GetNodeInfo(comm = comm, rc = status) - _VERIFY(STATUS) + call MAPL_GetNodeInfo(comm = comm, _RC) AmIRoot_ = MAPL_Am_I_Root(cap%vm) @@ -254,30 +250,24 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Note the call to GetLogger must be _after_ the call to MAPL_Set(). ! That call establishes the name of this component which is used in ! retrieving this component's logger. - call MAPL_GetLogger(gc, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(gc, lgr, _RC) ! Check if user wants to use node shared memory (default is no) !-------------------------------------------------------------- call MAPL_GetResource(MAPLOBJ, useShmem, label = 'USE_SHMEM:', default = 0, rc = status) if (useShmem /= 0) then - call MAPL_InitializeShmem (rc = status) - _VERIFY(status) + call MAPL_InitializeShmem (_RC) end if ! Check if a valid clock was provided externally !----------------------------------------------- - call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, rc=status) - _VERIFY(status) + call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, _RC) if (cap_clock_is_present) then - call ESMF_GridCompGet(gc, clock=cap_clock, rc=status) - _VERIFY(status) - call ESMF_ClockValidate(cap_clock, rc=status) - _VERIFY(status) - cap%clock = ESMF_ClockCreate(cap_clock, rc=status) - _VERIFY(status) + call ESMF_GridCompGet(gc, clock=cap_clock, _RC) + call ESMF_ClockValidate(cap_clock, _RC) + cap%clock = ESMF_ClockCreate(cap_clock, _RC) ! NOTE: We assume the MAPL components will only advance by ! one time step when driven with an external clock. !--------------------------------------------------------- @@ -292,8 +282,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! were after the last advance before the previous Finalize. !--------------------------------------------------------------------------- - call MAPL_ClockInit(MAPLOBJ, cap%clock, nsteps, rc = status) - _VERIFY(status) + call MAPL_ClockInit(MAPLOBJ, cap%clock, nsteps, _RC) cap%nsteps = nsteps cap%compute_throughput = .true. end if @@ -302,14 +291,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call set_reference_clock(cap%clock) #endif - call ESMF_ClockGet(cap%clock,currTime=cap%cap_restart_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(cap%clock,currTime=cap%cap_restart_time,_RC) - cap%clock_hist = ESMF_ClockCreate(cap%clock, rc = STATUS ) ! Create copy for HISTORY - _VERIFY(STATUS) + cap%clock_hist = ESMF_ClockCreate(cap%clock, _RC) ! Create copy for HISTORY - CoresPerNode = MAPL_CoresPerNodeGet(comm,rc=status) - _VERIFY(STATUS) + CoresPerNode = MAPL_CoresPerNodeGet(comm,_RC) ! We check resource for CoresPerNode (no longer needed to be in CAP.rc) ! If it is set in the resource, we issue an warning if the @@ -322,40 +308,30 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) end if end if - call ESMF_VMGet(cap%vm, petcount=npes, mpicommunicator=comm, rc=status) - _VERIFY(status) + call ESMF_VMGet(cap%vm, petcount=npes, mpicommunicator=comm, _RC) _ASSERT(CoresPerNode <= npes, 'something impossible happened') if (cap_clock_is_present) then - call ESMF_ClockGet(cap%clock, timeStep=frequency, rc=status) - _VERIFY(status) - call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, rc=status) - _VERIFY(status) + call ESMF_ClockGet(cap%clock, timeStep=frequency, _RC) + call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, _RC) else - call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", rc = status) - _VERIFY(status) - call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, rc = status) - _VERIFY(status) + call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", _RC) + call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, _RC) end if cap%heartbeat_dt = heartbeat_dt - perpetual = ESMF_AlarmCreate(clock = cap%clock_hist, name = 'PERPETUAL', ringinterval = frequency, sticky = .false., rc = status) - _VERIFY(status) - call ESMF_AlarmRingerOff(perpetual, rc = status) - _VERIFY(status) + perpetual = ESMF_AlarmCreate(clock = cap%clock_hist, name = 'PERPETUAL', ringinterval = frequency, sticky = .false., _RC) + call ESMF_AlarmRingerOff(perpetual, _RC) ! Set CLOCK for AGCM if not externally provided ! --------------------------------------------- if (.not.cap_clock_is_present) then - call MAPL_GetResource(MAPLOBJ, cap%perpetual_year, label='PERPETUAL_YEAR:', default = -999, rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, cap%perpetual_month, label='PERPETUAL_MONTH:', default = -999, rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, cap%perpetual_day, label='PERPETUAL_DAY:', default = -999, rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_year, label='PERPETUAL_YEAR:', default = -999, _RC) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_month, label='PERPETUAL_MONTH:', default = -999, _RC) + call MAPL_GetResource(MAPLOBJ, cap%perpetual_day, label='PERPETUAL_DAY:', default = -999, _RC) cap%lperp = ((cap%perpetual_day /= -999) .or. (cap%perpetual_month /= -999) .or. (cap%perpetual_year /= -999)) @@ -377,8 +353,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) clockname = trim(clockname) // '_PERPETUAL' call ESMF_Clockset(cap%clock_hist, name = clockname, rc = status) - call Perpetual_Clock(cap, rc=status) - _VERIFY(status) + call Perpetual_Clock(cap, _RC) endif endif @@ -389,151 +364,113 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !BOR ! !RESOURCE_ITEM: string :: Name of ROOT's config file - call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", _RC) ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component - call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", _RC) ! !RESOURCE_ITEM: string :: Name of HISTORY's config file - call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", _RC) ! !RESOURCE_ITEM: string :: Name of ExtData's config file - call MAPL_GetResource(MAPLOBJ, EXTDATA_CF, "EXTDATA_CF:", default = 'ExtData.rc', rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, EXTDATA_CF, "EXTDATA_CF:", default = 'ExtData.rc', _RC) ! !RESOURCE_ITEM: string :: Control Timers - call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', _RC) ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility - call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, rc = status) - _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', _RC) + call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, _RC) !EOR - enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) - _VERIFY(status) + enableTimers = ESMF_UtilStringUpperCase(enableTimers, _RC) call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (enableTimers /= 'YES') then - call MAPL_ProfDisable(rc = status) - _VERIFY(status) + call MAPL_ProfDisable(_RC) else call MAPL_GetResource(MAPLOBJ, timerModeStr, "MAPL_TIMER_MODE:", & - default='MINMAX', RC=STATUS ) - _VERIFY(STATUS) + default='MINMAX', _RC ) - timerModeStr = ESMF_UtilStringUpperCase(timerModeStr, rc=STATUS) - _VERIFY(STATUS) + timerModeStr = ESMF_UtilStringUpperCase(timerModeStr, _RC) end if cap%started_loop_timer=.false. - enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, rc=STATUS) - _VERIFY(STATUS) + enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, _RC) if (enableMemUtils /= 'YES') then - call MAPL_MemUtilsDisable( rc=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUtilsDisable( _RC ) else - call MAPL_MemUtilsInit( mode=MemUtilsMode, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUtilsInit( mode=MemUtilsMode, _RC ) end if - call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, _RC ) - call dirpaths%append(".",rc=status) - _VERIFY(status) - call ESMF_ConfigFindLabel(cap%config,Label='USER_DIRPATH:',isPresent=foundPath,rc=status) + call dirpaths%append(".",_RC) + call ESMF_ConfigFindLabel(cap%config,Label='USER_DIRPATH:',isPresent=foundPath,_RC) if (foundPath) then tend=.false. do while (.not.tend) - call ESMF_ConfigGetAttribute(cap%config,value=user_dirpath,default='',rc=status) + call ESMF_ConfigGetAttribute(cap%config,value=user_dirpath,default='',_RC) if (tempstring /= '') then - call dirpaths%append(user_dirpath,rc=status) - _VERIFY(status) + call dirpaths%append(user_dirpath,_RC) end if - call ESMF_ConfigNextLine(cap%config,tableEnd=tend,rc=status) - _VERIFY(STATUS) + call ESMF_ConfigNextLine(cap%config,tableEnd=tend,_RC) enddo end if ! Handle RUN_DT in ROOT_CF !------------------------- - cap%cf_root = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_root, ROOT_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_root = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_root, ROOT_CF, _RC ) - call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", rc=status) + call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", _RC) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and root RUN_DT (%g0)', heartbeat_dt, run_dt) _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else - call MAPL_ConfigSetAttribute(cap%cf_root, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=heartbeat_dt, Label="RUN_DT:", _RC) endif ! Add EXPID and EXPDSC from HISTORY.rc to AGCM.rc !------------------------------------------------ - cap%cf_hist = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_hist = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, _RC ) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', _RC) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', _RC) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=NY, Label="NY:", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=NY, Label="NY:", _RC) ! Add CoresPerNode from CAP.rc to HISTORY.rc and AGCM.rc !------------------------------------------------------- - call MAPL_ConfigSetAttribute(cap%cf_root, value=CoresPerNode, Label="CoresPerNode:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_hist, value=CoresPerNode, Label="CoresPerNode:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_root, value=CoresPerNode, Label="CoresPerNode:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=CoresPerNode, Label="CoresPerNode:", _RC) ! Add a SINGLE_COLUMN flag in HISTORY.rc based on DYCORE value(from AGCM.rc) !--------------------------------------------------------------------------- - call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", default = 'FV3', rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", default = 'FV3', _RC) if (DYCORE == 'DATMO') then snglcol = 1 - call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", _RC) end if ! Detect if this a regular replay in the AGCM.rc ! ---------------------------------------------- - call ESMF_ConfigGetAttribute(cap%cf_root, value=ReplayMode, Label="REPLAY_MODE:", default="NoReplay", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value=ReplayMode, Label="REPLAY_MODE:", default="NoReplay", _RC) ! Register the children with MAPL @@ -541,54 +478,45 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Create Root child !------------------- - call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, _RC) root_set_services => cap%root_set_services call t_p%start('SetService') if (.not.allocated(cap%root_dso)) then - cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) - _VERIFY(status) + cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, _RC) else sharedObj = trim(cap%root_dso) - cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, rc=status) - _VERIFY(status) + cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, _RC) end if root_gc => maplobj%get_child_gridcomp(cap%root_id) - call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) + call MAPL_GetObjectFromGC(root_gc, root_obj, _RC) _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") ! Create History child !---------------------- - call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, _RC) - cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) - _VERIFY(status) + cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, _RC) ! Create ExtData child !---------------------- - cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) - _VERIFY(STATUS) + cap%cf_ext = ESMF_ConfigCreate(_RC ) + call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, _RC ) - call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) + call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", _RC) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else - call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", _RC) endif - call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) - _VERIFY(STATUS) + call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, _RC) if (use_extdata2g) then #if defined(BUILD_WITH_EXTDATA2G) @@ -603,25 +531,18 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call t_p%stop('SetService') ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXPID, Label="EXPID:", rc=status) - _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXPID, Label="EXPID:", _RC) ! Query MAPL for the the children's for GCS, IMPORTS, EXPORTS !------------------------------------------------------------- call MAPL_Get(MAPLOBJ, childrens_gridcomps = cap%gcs, & - childrens_import_states = cap%child_imports, childrens_export_states = cap%child_exports, rc = status) - _VERIFY(status) + childrens_import_states = cap%child_imports, childrens_export_states = cap%child_exports, _RC) ! Inject grid to root child if grid has been set externally @@ -636,10 +557,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) if (cap%printSpec>0) then - call MAPL_StatePrintSpecCSV(cap%gcs(cap%root_id), cap%printspec, rc = status) - _VERIFY(status) - call ESMF_VMBarrier(cap%vm, rc = status) - _VERIFY(status) + call MAPL_StatePrintSpecCSV(cap%gcs(cap%root_id), cap%printspec, _RC) + call ESMF_VMBarrier(cap%vm, _RC) else ! Initialize the Computational Hierarchy !---------------------------------------- @@ -649,20 +568,16 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) - call cap%initialize_history(rc=status) - _VERIFY(status) + call cap%initialize_history(_RC) - call cap%initialize_extdata(root_gc,rc=status) - _VERIFY(status) + call cap%initialize_extdata(root_gc,_RC) ! Finally check is this is a regular replay ! If so stuff gc and input state for ExtData in GCM internal state ! ----------------------------------------------------------------- if (trim(replayMode)=="Regular") then - call MAPL_GCGet(CAP%GCS(cap%root_id),"GCM",gcmGC,rc=status) - _VERIFY(STATUS) - call ESMF_GridCompGet(gcmGC,vm=gcmVM,rc=status) - _VERIFY(STATUS) + call MAPL_GCGet(CAP%GCS(cap%root_id),"GCM",gcmGC,_RC) + call ESMF_GridCompGet(gcmGC,vm=gcmVM,_RC) _ASSERT(cap%vm==gcmVM,'CAP and GCM should agree on their VMs.') call ESMF_UserCompGetInternalState(gcmGC,'ExtData_state',wrap,status) _VERIFY(STATUS) @@ -688,16 +603,13 @@ subroutine initialize_history(cap, rc) if (present(rc)) rc = ESMF_SUCCESS ! All the EXPORTS of the Hierachy are made IMPORTS of History !------------------------------------------------------------ - call ESMF_StateAdd(cap%child_imports(cap%history_id), [cap%child_exports(cap%root_id)], rc = status) - _VERIFY(STATUS) + call ESMF_StateAdd(cap%child_imports(cap%history_id), [cap%child_exports(cap%root_id)], _RC) - allocate(lswrap%ptr, stat = status) - _VERIFY(STATUS) + allocate(lswrap%ptr, _STAT) call ESMF_UserCompSetInternalState(cap%gcs(cap%history_id), 'MAPL_LocStreamList', & lswrap, STATUS) _VERIFY(STATUS) - call MAPL_GetAllExchangeGrids(CAP%GCS(cap%root_id), LSADDR, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GetAllExchangeGrids(CAP%GCS(cap%root_id), LSADDR, _RC) lswrap%ptr%LSADDR_PTR => LSADDR ! Initialize the History @@ -720,7 +632,7 @@ subroutine initialize_extdata(cap , root_gc, rc) character(len=ESMF_MAXSTR ), pointer :: item_names(:) type(ESMF_Field) :: field type(ESMF_FieldBundle) :: bundle - type(StringVector) :: cap_imports_vec, cap_exports_vec + type(StringVector) :: cap_imports_vec, cap_exports_vec, extdata_imports_vec type(StringVectorIterator) :: iter integer :: i type(ESMF_State) :: state, root_imports, component_state @@ -728,8 +640,9 @@ subroutine initialize_extdata(cap , root_gc, rc) ! Prepare EXPORTS for ExtData ! --------------------------- - cap_imports_vec = get_vec_from_config(cap%config, "CAP_IMPORTS") - cap_exports_vec = get_vec_from_config(cap%config, "CAP_EXPORTS") + cap_imports_vec = get_vec_from_config(cap%config, "CAP_IMPORTS", _RC) + cap_exports_vec = get_vec_from_config(cap%config, "CAP_EXPORTS", _RC) + extdata_imports_vec = get_vec_from_config(cap%config, "EXTDATA_IMPORTS") cap%import_state = ESMF_StateCreate(name = "Cap_Imports", stateintent = ESMF_STATEINTENT_IMPORT) cap%export_state = ESMF_StateCreate(name = "Cap_Exports", stateintent = ESMF_STATEINTENT_EXPORT) @@ -747,27 +660,37 @@ subroutine initialize_extdata(cap , root_gc, rc) component_state, status) _VERIFY(status) - call ESMF_StateGet(component_state, trim(field_name), field, rc = status) - _VERIFY(status) + call ESMF_StateGet(component_state, trim(field_name), field, _RC) - call MAPL_StateAdd(cap%export_state, field, rc = status) - _VERIFY(status) + call MAPL_StateAdd(cap%export_state, field, _RC) call iter%next() end do end if + if (extdata_imports_vec%size() /= 0) then + iter = extdata_imports_vec%begin() + do while(iter /= extdata_imports_vec%end()) + component_name = iter%get() + component_name = trim(component_name(index(component_name, ",")+1:)) - call ESMF_StateGet(cap%child_imports(cap%root_id), itemcount = item_count, rc = status) - _VERIFY(status) - allocate(item_names(item_count), stat = status) - _VERIFY(status) - allocate(item_types(item_count), stat = status) - _VERIFY(status) + field_name = iter%get() + field_name = trim(field_name(1:index(field_name, ",")-1)) + + call MAPL_ExportStateGet([cap%child_exports(cap%root_id)], component_name, & + component_state, _RC) + call ESMF_StateGet(component_state, trim(field_name), field, _RC) + call MAPL_StateAdd(cap%child_imports(cap%extdata_id), field, _RC) + call iter%next() + end do + end if + + call ESMF_StateGet(cap%child_imports(cap%root_id), itemcount = item_count, _RC) + allocate(item_names(item_count), _STAT) + allocate(item_types(item_count), _STAT) call ESMF_StateGet(cap%child_imports(cap%root_id), itemnamelist = item_names, & - itemtypelist = item_types, rc = status) - _VERIFY(status) + itemtypelist = item_types, _RC) root_imports = cap%child_imports(cap%root_id) do i = 1, item_count @@ -778,16 +701,12 @@ subroutine initialize_extdata(cap , root_gc, rc) end if if (item_types(i) == ESMF_StateItem_Field) then - call ESMF_StateGet(root_imports, item_names(i), field, rc = status) - _VERIFY(status) + call ESMF_StateGet(root_imports, item_names(i), field, _RC) call MAPL_AddAttributeToFields(root_gc,trim(item_names(i)),'RESTART',MAPL_RestartSkip,_RC) - call MAPL_StateAdd(state, field, rc = status) - _VERIFY(status) + call MAPL_StateAdd(state, field, _RC) else if (item_types(i) == ESMF_StateItem_FieldBundle) then - call ESMF_StateGet(root_imports, item_names(i), bundle, rc = status) - _VERIFY(status) - call MAPL_StateAdd(state, bundle, rc = status) - _VERIFY(status) + call ESMF_StateGet(root_imports, item_names(i), bundle, _RC) + call MAPL_StateAdd(state, bundle, _RC) end if end do @@ -825,10 +744,10 @@ subroutine run_gc(gc, import, export, clock, rc) t_p => get_global_time_profiler() call t_p%start('Run') - call ESMF_GridCompGet( gc, currentPhase=phase, RC=status ) + call ESMF_GridCompGet( gc, currentPhase=phase, _RC ) VERIFY_(status) - call run_MAPL_GridComp(gc, phase=phase, rc=status) + call run_MAPL_GridComp(gc, phase=phase, _RC) _VERIFY(status) call t_p%stop('Run') @@ -855,8 +774,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - call MAPL_GetObjectFromGC(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(gc, maplobj, _RC) t_p => get_global_time_profiler() call t_p%start('Finalize') @@ -876,20 +794,14 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) - call CAP_Finalize(CAP%CLOCK_HIST, "cap_restart", rc=STATUS) - _VERIFY(status) + call CAP_Finalize(CAP%CLOCK_HIST, "cap_restart", _RC) - call ESMF_ConfigDestroy(cap%cf_ext, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%cf_hist, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%cf_root, rc = status) - _VERIFY(status) - call ESMF_ConfigDestroy(cap%config, rc = status) - _VERIFY(status) + call ESMF_ConfigDestroy(cap%cf_ext, _RC) + call ESMF_ConfigDestroy(cap%cf_hist, _RC) + call ESMF_ConfigDestroy(cap%cf_root, _RC) + call ESMF_ConfigDestroy(cap%config, _RC) - call MAPL_FinalizeShmem(rc = status) - _VERIFY(STATUS) + call MAPL_FinalizeShmem(_RC) ! Write EGRESS file !------------------ @@ -918,16 +830,13 @@ subroutine set_services_gc(gc, rc) type(MAPL_CapGridComp), pointer :: cap cap => get_CapGridComp_from_gc(gc) - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, _RC) do phase = 1, cap%n_run_phases - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, _RC) enddo - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine set_services_gc @@ -938,8 +847,7 @@ subroutine set_services(this, rc) integer, optional, intent(out) :: rc integer :: status - call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetServices(this%gc, set_services_gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine set_services @@ -967,8 +875,7 @@ subroutine run(this, phase, rc) phase_ = 1 if (present(phase)) phase_ = phase - call ESMF_GridCompRun(this%gc, phase=phase_, userrc=userrc, rc=status) - _VERIFY(status) + call ESMF_GridCompRun(this%gc, phase=phase_, userrc=userrc, _RC) _VERIFY(userrc) _RETURN(ESMF_SUCCESS) @@ -980,8 +887,7 @@ subroutine finalize(this, rc) integer :: status - call ESMF_GridCompFinalize(this%gc, rc = status) - _VERIFY(status) + call ESMF_GridCompFinalize(this%gc, _RC) _RETURN(ESMF_SUCCESS) end subroutine finalize @@ -1029,8 +935,7 @@ function get_current_time(this, rc) result (current_time) type(ESMF_Time) :: current_time integer, optional, intent(out) :: rc integer :: status - call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,currTime=current_time,_RC) _RETURN(ESMF_SUCCESS) @@ -1067,25 +972,24 @@ end function get_CapGridComp_from_gc - function get_vec_from_config(config, key) result(vec) + function get_vec_from_config(config, key, rc) result(vec) type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: key - logical :: present - integer :: status, rc + integer, intent(out), optional :: rc + logical :: present, tableEnd + integer :: status character(len=ESMF_MAXSTR) :: cap_import type(StringVector) :: vec - call ESMF_ConfigFindLabel(config, key//":", isPresent = present, rc = status) - _VERIFY(status) + call ESMF_ConfigFindLabel(config, key//":", isPresent = present, _RC) cap_import = "" if (present) then do while(trim(cap_import) /= "::") - call ESMF_ConfigNextLine(config, rc = status) - _VERIFY(status) - call ESMF_ConfigGetAttribute(config, cap_import, rc = status) - _VERIFY(status) + call ESMF_ConfigNextLine(config, tableEnd=tableEnd, _RC) + if (tableEnd) exit + call ESMF_ConfigGetAttribute(config, cap_import, _RC) if (trim(cap_import) /= "::") call vec%push_back(trim(cap_import)) end do end if @@ -1128,8 +1032,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) procedure(), pointer :: root_set_services cap => get_CapGridComp_from_gc(gc) - call MAPL_GetObjectFromGC(gc, maplobj, rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(gc, maplobj, _RC) phase_ = 1 if (present(phase)) phase_ = phase @@ -1139,8 +1042,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) ! Time Loop starts by checking for Segment Ending Time !----------------------------------------------------- if (cap%compute_throughput) then - call ESMF_VMBarrier(cap%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(cap%vm,_RC) cap%starts%loop_start_timer = MPI_WTime() cap%started_loop_timer = .true. end if @@ -1151,25 +1053,21 @@ subroutine run_MAPL_GridComp(gc, phase, rc) call cap%increment_step_counter() - call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', rc = status) - _VERIFY(status) + call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', _RC) if (.not.cap%lperp) then - done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) - _VERIFY(status) + done = ESMF_ClockIsStopTime(cap%clock_hist, _RC) if (done) exit endif - call cap%step(phase=phase_, rc=status) - _VERIFY(status) + call cap%step(phase=phase_, _RC) ! Reset loop average timer to get a better ! estimate of true run time left by ignoring ! initialization costs in the averageing. !------------------------------------------- if (n == 1 .and. cap%compute_throughput) then - call ESMF_VMBarrier(cap%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(cap%vm,_RC) cap%starts%loop_start_timer = MPI_WTime() endif @@ -1200,8 +1098,7 @@ subroutine step(this, unusable, phase, rc) ! -------------------------- if (phase_ == 1) then - call first_phase(rc=status) - _VERIFY(status) + call first_phase(_RC) endif ! phase_ == 1 ! Run the Gridded Component @@ -1214,8 +1111,7 @@ subroutine step(this, unusable, phase, rc) ! --------------------------------------------------- if (phase_ == this%n_run_phases) then - call last_phase(rc=status) - _VERIFY(STATUS) + call last_phase(_RC) endif !phase_ == last @@ -1252,8 +1148,7 @@ subroutine first_phase(rc) _VERIFY(status) if (this%compute_throughput) then - call ESMF_VMBarrier(this%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(this%vm,_RC) this%starts%start_run_timer = MPI_WTime() end if @@ -1266,15 +1161,12 @@ subroutine last_phase(rc) integer :: status if (this%compute_throughput) then - call ESMF_VMBarrier(this%vm,rc=status) - _VERIFY(status) + call ESMF_VMBarrier(this%vm,_RC) end_run_timer = MPI_WTime() end if - call ESMF_ClockAdvance(this%clock, rc = status) - _VERIFY(STATUS) - call ESMF_ClockAdvance(this%clock_hist, rc = status) - _VERIFY(STATUS) + call ESMF_ClockAdvance(this%clock, _RC) + call ESMF_ClockAdvance(this%clock_hist, _RC) ! Update Perpetual Clock ! ---------------------- @@ -1290,8 +1182,7 @@ subroutine last_phase(rc) ! Estimate throughput times ! --------------------------- if (this%compute_throughput) then - call print_throughput(rc=status) - _VERIFY(STATUS) + call print_throughput(_RC) end if _RETURN(_SUCCESS) @@ -1314,19 +1205,16 @@ subroutine print_throughput(rc) integer :: HRS_R, MIN_R, SEC_R - call ESMF_ClockGet(this%clock, CurrTime = currTime, rc = status) - _VERIFY(status) + call ESMF_ClockGet(this%clock, CurrTime = currTime, _RC) call ESMF_TimeGet(CurrTime, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & H = AGCM_H , & M = AGCM_M , & - S = AGCM_S, rc=status) - _VERIFY(status) + S = AGCM_S, _RC) delt=currTime-this%cap_restart_time ! Call system clock to estimate throughput simulated Days/Day - call ESMF_VMBarrier( this%vm, RC=STATUS ) - _VERIFY(STATUS) + call ESMF_VMBarrier( this%vm, _RC ) END_TIMER = MPI_Wtime() n=this%get_step_counter() !GridCompRun Timer [Inst] @@ -1343,11 +1231,9 @@ subroutine print_throughput(rc) ! Reset Inst timer this%starts%start_timer = END_TIMER ! Get percent of used memory - call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, RC=STATUS ) - _VERIFY(STATUS) + call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, _RC ) ! Get percent of committed memory - call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, RC=STATUS ) - _VERIFY(STATUS) + call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, _RC ) if( mapl_am_I_Root(this%vm) ) write(6,1000) AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S,& LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& @@ -1370,21 +1256,17 @@ subroutine record_state(this, rc) integer :: nalarms,i - call MAPL_GetObjectFromGC(this%gcs(this%root_id),maplobj,rc=status) - _VERIFY(status) + call MAPL_GetObjectFromGC(this%gcs(this%root_id),maplobj,_RC) call MAPL_GenericStateSave(this%gcs(this%root_id),this%child_imports(this%root_id), & - this%child_exports(this%root_id),this%clock,rc=status) + this%child_exports(this%root_id),this%clock,_RC) - call ESMF_ClockGet(this%clock,alarmCount=nalarms,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,alarmCount=nalarms,_RC) - allocate(this%alarm_list(nalarms),this%ringingState(nalarms),this%alarmRingTime(nalarms),stat=status) - _VERIFY(status) + allocate(this%alarm_list(nalarms),this%ringingState(nalarms),this%alarmRingTime(nalarms),_STAT) call ESMF_ClockGetAlarmList(this%clock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=this%alarm_list, rc=status) - _VERIFY(status) + alarmList=this%alarm_list, _RC) do i = 1, nalarms - call ESMF_AlarmGet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) + call ESMF_AlarmGet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), _RC) VERIFY_(STATUS) end do @@ -1399,11 +1281,9 @@ subroutine refresh_state(this, rc) integer :: i call MAPL_GenericStateRestore(this%gcs(this%root_id),this%child_imports(this%root_id), & - this%child_exports(this%root_id),this%clock,rc=status) - _VERIFY(status) + this%child_exports(this%root_id),this%clock,_RC) DO I = 1, size(this%alarm_list) - call ESMF_AlarmSet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), rc=status) - _VERIFY(STATUS) + call ESMF_AlarmSet(this%alarm_list(I), ringTime=this%alarmRingTime(I), ringing=this%ringingState(I), _RC) END DO _RETURN(_SUCCESS) @@ -1421,10 +1301,8 @@ subroutine get_field_from_import(this,field_name,state_name,field,rc) type(ESMF_State) :: state call MAPL_ImportStateGet(this%gcs(this%root_id),this%child_imports(this%root_id),& - state_name,state,rc=status) - _VERIFY(status) - call ESMF_StateGet(state,trim(field_name),field,rc=status) - _VERIFY(status) + state_name,state,_RC) + call ESMF_StateGet(state,trim(field_name),field,_RC) _RETURN(_SUCCESS) end subroutine get_field_from_import @@ -1439,10 +1317,8 @@ subroutine get_field_from_internal(this,field_name,state_name,field,rc) type(ESMF_State) :: state - call MAPL_InternalESMFStateGet(this%gcs(this%root_id),state_name,state,rc=status) - _VERIFY(status) - call ESMF_StateGet(state,trim(field_name),field,rc=status) - _VERIFY(status) + call MAPL_InternalESMFStateGet(this%gcs(this%root_id),state_name,state,_RC) + call ESMF_StateGet(state,trim(field_name),field,_RC) _RETURN(_SUCCESS) end subroutine get_field_from_internal @@ -1466,7 +1342,7 @@ subroutine set_grid(this, grid, unusable, lm, grid_type, rc) external_grid_factory = ExternalGridFactory(grid=grid, lm=lm, _RC) mapl_grid = grid_manager%make_grid(external_grid_factory, _RC) ! grid_type is an optional parameter that allows GridType to be set explicitly. - call ESMF_ConfigGetAttribute(this%config, value = grid_type_, Label="GridType:", default="", rc=status) + call ESMF_ConfigGetAttribute(this%config, value = grid_type_, Label="GridType:", default="", _RC) if (status == ESMF_RC_OBJ_NOT_CREATED) then grid_type_ = "" else @@ -1548,8 +1424,7 @@ subroutine destroy_state(this, rc) integer, intent(out) :: rc integer :: status - call MAPL_DestroyStateSave(this%gcs(this%root_id),rc=status) - _VERIFY(status) + call MAPL_DestroyStateSave(this%gcs(this%root_id),_RC) if (allocated(this%alarm_list)) deallocate(this%alarm_list) if (allocated(this%AlarmRingTime)) deallocate(this%alarmRingTime) @@ -1566,36 +1441,26 @@ subroutine rewind_clock(this, time, rc) integer :: status type(ESMF_Time) :: current_time,ct - call ESMF_ClockGet(this%clock,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock,currTime=current_time,_RC) if (current_time > time) then - call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,_RC) do - call ESMF_ClockAdvance(this%clock,rc=status) - _VERIFY(status) - call ESMF_ClockGet(this%clock,currTime=ct,rc=status) - _VERIFY(status) + call ESMF_ClockAdvance(this%clock,_RC) + call ESMF_ClockGet(this%clock,currTime=ct,_RC) if (ct==time) exit enddo - call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,_RC) end if - call ESMF_ClockGet(this%clock_hist,currTime=current_time,rc=status) - _VERIFY(status) + call ESMF_ClockGet(this%clock_hist,currTime=current_time,_RC) if (current_time > time) then - call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,_RC) do - call ESMF_ClockAdvance(this%clock_hist,rc=status) - _VERIFY(status) - call ESMF_ClockGet(this%clock_hist,currTime=ct,rc=status) - _VERIFY(status) + call ESMF_ClockAdvance(this%clock_hist,_RC) + call ESMF_ClockGet(this%clock_hist,currTime=ct,_RC) if (ct==time) exit enddo - call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,rc=status) - _VERIFY(status) + call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,_RC) end if @@ -1679,7 +1544,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) !BOR - call MAPL_GetResource( MAPLOBJ, datetime, label='BEG_DATE:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='BEG_DATE:', _RC ) if(STATUS==ESMF_SUCCESS) then _ASSERT(is_valid_date(datetime(1)),'Invalid date in BEG_DATE') _ASSERT(is_valid_time(datetime(2)),'Invalid time in BEG_DATE') @@ -1687,93 +1552,71 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) else ! !RESOURCE_ITEM: year :: Beginning year (integer) - call MAPL_GetResource( MAPLOBJ, BEG_YY, label='BEG_YY:', DEFAULT=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_YY, label='BEG_YY:', DEFAULT=1, _RC ) ! !RESOURCE_ITEM: month :: Beginning month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, BEG_MM, label='BEG_MM:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_MM, label='BEG_MM:', default=1, _RC ) ! !RESOURCE_ITEM: day :: Beginning day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, BEG_DD, label='BEG_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_DD, label='BEG_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Beginning hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, BEG_H , label='BEG_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_H , label='BEG_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Beginning minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, BEG_M , label='BEG_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_M , label='BEG_M:' , default=0, _RC ) ! !RESOURCE_ITEM: second :: Beginning second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, BEG_S , label='BEG_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, BEG_S , label='BEG_S:' , default=0, _RC ) end if - call MAPL_GetResource( MAPLOBJ, datetime, label='END_DATE:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='END_DATE:', _RC ) if(STATUS==ESMF_SUCCESS) then _ASSERT(is_valid_date(datetime(1)),'Invalid date in END_DATE') _ASSERT(is_valid_time(datetime(2)),'Invalid time in END_DATE') CALL MAPL_UnpackDateTime(DATETIME, END_YY, END_MM, END_DD, END_H, END_M, END_S) else ! !RESOURCE_ITEM: year :: Ending year (integer) - call MAPL_GetResource( MAPLOBJ, END_YY, label='END_YY:', DEFAULT=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_YY, label='END_YY:', DEFAULT=1, _RC ) ! !RESOURCE_ITEM: month :: Ending month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, END_MM, label='END_MM:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_MM, label='END_MM:', default=1, _RC ) ! !RESOURCE_ITEM: day :: Ending day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, END_DD, label='END_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_DD, label='END_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Ending hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, END_H , label='END_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_H , label='END_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Ending minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, END_M , label='END_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_M , label='END_M:' , default=0, _RC ) ! !RESOURCE_ITEM: second :: Ending second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, END_S , label='END_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, END_S , label='END_S:' , default=0, _RC ) end if ! Replace JOB_DURATION with JOB_SGMT as prefered RC parameter ! ----------------------------------------------------------- - call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_SGMT:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_SGMT:', _RC ) if(STATUS/=ESMF_SUCCESS) then - call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_DURATION:', rc=STATUS ) + call MAPL_GetResource( MAPLOBJ, datetime, label='JOB_DURATION:', _RC ) end if if(STATUS==ESMF_SUCCESS) then CALL MAPL_UnpackDateTime(DATETIME, DUR_YY, DUR_MM, DUR_DD, DUR_H, DUR_M, DUR_S) else ! !RESOURCE_ITEM: year :: Ending year (integer) - call MAPL_GetResource( MAPLOBJ, DUR_YY, label='DUR_YY:', DEFAULT=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_YY, label='DUR_YY:', DEFAULT=0, _RC ) ! !RESOURCE_ITEM: month :: Ending month (integer 1-12) - call MAPL_GetResource( MAPLOBJ, DUR_MM, label='DUR_MM:', default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_MM, label='DUR_MM:', default=0, _RC ) ! !RESOURCE_ITEM: day :: Ending day of month (integer 1-31) - call MAPL_GetResource( MAPLOBJ, DUR_DD, label='DUR_DD:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_DD, label='DUR_DD:', default=1, _RC ) ! !RESOURCE_ITEM: hour :: Ending hour of day (integer 0-23) - call MAPL_GetResource( MAPLOBJ, DUR_H , label='DUR_H:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_H , label='DUR_H:' , default=0, _RC ) ! !RESOURCE_ITEM: minute :: Ending minute (integer 0-59) - call MAPL_GetResource( MAPLOBJ, DUR_M , label='DUR_M:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_M , label='DUR_M:' , default=0, _RC ) ! !xRESOURCE_ITEM: second :: Ending second (integer 0-59) - call MAPL_GetResource( MAPLOBJ, DUR_S , label='DUR_S:' , default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DUR_S , label='DUR_S:' , default=0, _RC ) end if ! !RESOURCE_ITEM: seconds :: Interval of the application clock (the Heartbeat) - call MAPL_GetResource( MAPLOBJ, HEARTBEAT_DT, label='HEARTBEAT_DT:', rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, HEARTBEAT_DT, label='HEARTBEAT_DT:', _RC ) ! !RESOURCE_ITEM: 1 :: numerator of decimal fraction of time step - call MAPL_GetResource( MAPLOBJ, NUM_DT, label='NUM_DT:', default=0, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, NUM_DT, label='NUM_DT:', default=0, _RC ) ! !RESOURCE_ITEM: 1 :: denominator of decimal fraction of time step - call MAPL_GetResource( MAPLOBJ, DEN_DT, label='DEN_DT:', default=1, rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, DEN_DT, label='DEN_DT:', default=1, _RC ) ! !RESOURCE_ITEM: string :: Calendar type - call MAPL_GetResource( MAPLOBJ, calendar, label='CALENDAR:', default="GREGORIAN", rc=STATUS ) - _VERIFY(STATUS) + call MAPL_GetResource( MAPLOBJ, calendar, label='CALENDAR:', default="GREGORIAN", _RC ) !EOR @@ -1786,20 +1629,14 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) ! ---------------------------------------- if (calendar=="GREGORIAN") then - cal = ESMF_CalendarCreate( ESMF_CALKIND_GREGORIAN, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_GREGORIAN, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_GREGORIAN, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_GREGORIAN, _RC) elseif(calendar=="JULIAN" ) then - cal = ESMF_CalendarCreate( ESMF_CALKIND_JULIAN, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_JULIAN, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_JULIAN, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_JULIAN, _RC) elseif(calendar=="NOLEAP" ) then - cal = ESMF_CalendarCreate( ESMF_CALKIND_NOLEAP, name="ApplicationCalendar", rc=status ) - _VERIFY(STATUS) - call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, RC=STATUS) - _VERIFY(STATUS) + cal = ESMF_CalendarCreate( ESMF_CALKIND_NOLEAP, name="ApplicationCalendar", _RC ) + call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, _RC) else _FAIL('Unsupported calendar:'//trim(calendar)) endif @@ -1813,8 +1650,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = BEG_H , & M = BEG_M , & S = BEG_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) call ESMF_TimeSet( EndTime, YY = END_YY, & MM = END_MM, & @@ -1822,8 +1658,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = END_H , & M = END_M , & S = END_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) ! Read CAP Restart File for Current Time ! -------------------------------------- @@ -1835,8 +1670,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) CUR_M = BEG_M CUR_S = BEG_S - UNIT = GETFILE ( "cap_restart", form="formatted", ALL_PES=.true., rc=status ) - _VERIFY(STATUS) + UNIT = GETFILE ( "cap_restart", form="formatted", ALL_PES=.true., _RC ) rewind(UNIT) read(UNIT,100,err=999,end=999) datetime @@ -1846,8 +1680,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) _ASSERT(is_valid_time(DATETIME(2)),'Invalid time in cap_restart') CALL MAPL_UnpackDateTime(DATETIME, CUR_YY, CUR_MM, CUR_DD, CUR_H, CUR_M, CUR_S) - call MAPL_GetLogger(MAPLOBJ, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(MAPLOBJ, lgr, _RC) call lgr%info('Read CAP restart properly, Current Date = %i4.4~/%i2.2~/%i2.2', CUR_YY, CUR_MM, CUR_DD) call lgr%info(' Current Time = %i2.2~/%i2.2~/%i2.2', CUR_H, CUR_M, CUR_S) @@ -1863,8 +1696,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) H = CUR_H , & M = CUR_M , & S = CUR_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + calendar=cal, _RC) ! initialize final stop time @@ -1877,8 +1709,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) M = DUR_M , & S = DUR_S , & startTime = currTime, & - rc = STATUS ) - _VERIFY(STATUS) + _RC) maxDuration = EndTime - currTime if (duration > maxDuration) duration = maxDuration @@ -1888,8 +1719,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) ! initialize model time step ! -------------------------- - call ESMF_TimeIntervalSet( timeStep, S=HEARTBEAT_DT, sN=NUM_DT, sD=DEN_DT, rc=STATUS ) - _VERIFY(STATUS) + call ESMF_TimeIntervalSet( timeStep, S=HEARTBEAT_DT, sN=NUM_DT, sD=DEN_DT, _RC ) nsteps = duration/timestep @@ -1900,15 +1730,13 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) if (endTime < stopTime) then clock = ESMF_ClockCreate( name="ApplClock", timeStep=timeStep, & - startTime=StartTime, stopTime=EndTime, rc=STATUS ) + startTime=StartTime, stopTime=EndTime, _RC ) else clock = ESMF_ClockCreate( name="ApplClock", timeStep=timeStep, & - startTime=StartTime, stopTime=StopTime, rc=STATUS ) + startTime=StartTime, stopTime=StopTime, _RC ) end if - _VERIFY(STATUS) - call ESMF_ClockSet ( clock, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockSet ( clock, CurrTime=CurrTime, _RC ) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ClockInit @@ -1934,15 +1762,13 @@ subroutine CAP_FINALIZE ( clock,filen, rc ) ! Retrieve Current Time for Cap Restart ! ------------------------------------- - call ESMF_ClockGet ( clock, currTime=currentTime, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock, currTime=currentTime, _RC ) call ESMF_TimeGet ( CurrentTime, YY = YY, & MM = MM, & DD = DD, & H = H , & M = M , & - S = S, rc=status ) - _VERIFY(STATUS) + S = S, _RC ) CALL MAPL_PackDateTime(DATETIME, YY, MM, DD, H, M, S) @@ -1982,33 +1808,26 @@ subroutine Perpetual_Clock (this, rc) perpetual_year = this%perpetual_year perpetual_month = this%perpetual_month perpetual_day = this%perpetual_day - call MAPL_GetLogger(this%gc, lgr, rc=status) - _VERIFY(status) + call MAPL_GetLogger(this%gc, lgr, _RC) - call ESMF_ClockGetAlarm ( clock_HIST, alarmName='PERPETUAL', alarm=PERPETUAL, rc=status ) - _VERIFY(STATUS) - call ESMF_AlarmRingerOff( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGetAlarm ( clock_HIST, alarmName='PERPETUAL', alarm=PERPETUAL, _RC ) + call ESMF_AlarmRingerOff( PERPETUAL, _RC ) - call ESMF_ClockGet ( clock, currTime=currTime, calendar=cal, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock, currTime=currTime, calendar=cal, _RC ) call ESMF_TimeGet ( CurrTime, YY = AGCM_YY, & MM = AGCM_MM, & DD = AGCM_DD, & H = AGCM_H , & M = AGCM_M , & - S = AGCM_S, rc=status ) - _VERIFY(STATUS) + S = AGCM_S, _RC ) - call ESMF_ClockGet ( clock_HIST, CurrTime=CurrTime, calendar=cal, rc=status ) - _VERIFY(STATUS) + call ESMF_ClockGet ( clock_HIST, CurrTime=CurrTime, calendar=cal, _RC ) call ESMF_TimeGet ( CurrTime, YY = HIST_YY, & MM = HIST_MM, & DD = HIST_DD, & H = HIST_H , & M = HIST_M , & - S = HIST_S, rc=status ) - _VERIFY(STATUS) + S = HIST_S, _RC ) call lgr%debug('Inside PERP M0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S) call lgr%debug('Inside PERP H0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', HIST_YY,HIST_MM,HIST_DD,HIST_H,HIST_M,HIST_S) @@ -2027,8 +1846,7 @@ subroutine Perpetual_Clock (this, rc) if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif call lgr%debug('Inside PERP M0: %i4.4~/%i2.2~/%i2.2 Time: %i2.2~/%i2.2~/%i2.2', AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S) @@ -2044,8 +1862,7 @@ subroutine Perpetual_Clock (this, rc) HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 AGCM_YY = HIST_YY - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif endif @@ -2058,8 +1875,7 @@ subroutine Perpetual_Clock (this, rc) if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 - call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) - _VERIFY(STATUS) + call ESMF_AlarmRingerOn( PERPETUAL, _RC ) endif endif @@ -2069,10 +1885,8 @@ subroutine Perpetual_Clock (this, rc) H = AGCM_H , & M = AGCM_M , & S = AGCM_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) - call ESMFL_ClockSet ( clock, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + calendar=cal, _RC) + call ESMFL_ClockSet ( clock, CurrTime=CurrTime, _RC ) call ESMF_TimeSet( CurrTime, YY = HIST_YY, & MM = HIST_MM, & @@ -2080,10 +1894,8 @@ subroutine Perpetual_Clock (this, rc) H = HIST_H , & M = HIST_M , & S = HIST_S , & - calendar=cal, rc = STATUS ) - _VERIFY(STATUS) - call ESMFL_ClockSet ( clock_HIST, CurrTime=CurrTime, rc=status ) - _VERIFY(STATUS) + calendar=cal, _RC) + call ESMFL_ClockSet ( clock_HIST, CurrTime=CurrTime, _RC ) _RETURN(ESMF_SUCCESS) end subroutine Perpetual_Clock @@ -2113,26 +1925,21 @@ subroutine ESMFL_ClockSet(clock, currTime, rc) targetTime = currTime ! get the CurrentTime from the clock - call ESMF_ClockGet(clock, alarmCount = nalarms, currTime=cTime, rc=status) - _VERIFY(STATUS) + call ESMF_ClockGet(clock, alarmCount = nalarms, currTime=cTime, _RC) delt = targetTime - cTime - call ESMF_TimeIntervalSet(zero, rc=status) - _VERIFY(STATUS) + call ESMF_TimeIntervalSet(zero, _RC) ! Get the list of current alarms in the clock - allocate (alarmList(nalarms), stat = status) - _VERIFY(STATUS) + allocate (alarmList(nalarms), _STAT) call ESMF_ClockGetAlarmList(clock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=alarmList, alarmCount = nalarms, rc=status) - _VERIFY(STATUS) + alarmList=alarmList, alarmCount = nalarms, _RC) ! Loop over all alarms DO I = 1, nalarms call ESMF_AlarmGet(alarmList(I), ringTime=ringTime, ringInterval=ringInterval, & - ringing=ringing, rc=status) - _VERIFY(STATUS) + ringing=ringing, _RC) ! skip alarms with zero ringing interval if (ringInterval == zero) cycle @@ -2140,21 +1947,17 @@ subroutine ESMFL_ClockSet(clock, currTime, rc) _ASSERT(mod(delt,ringInterval) == zero, 'Time-shift should be a multiple of ringing interval.') ringTime=ringTime + delt - call ESMF_AlarmSet(alarmList(I), ringTime=ringTime, ringing=ringing, rc=status) - _VERIFY(STATUS) + call ESMF_AlarmSet(alarmList(I), ringTime=ringTime, ringing=ringing, _RC) END DO ! Protection in case we reset the clock outside of StopTime - call ESMF_ClockStopTimeDisable(clock, rc=status) - _VERIFY(STATUS) + call ESMF_ClockStopTimeDisable(clock, _RC) - call ESMF_ClockSet(clock, currTime=targetTime, rc=status) - _VERIFY(STATUS) + call ESMF_ClockSet(clock, currTime=targetTime, _RC) ! We do not need the protection anymore - call ESMF_ClockStopTimeEnable(clock, rc=status) - _VERIFY(STATUS) + call ESMF_ClockStopTimeEnable(clock, _RC) ! clean-up deallocate(alarmList) From 56c1de270ff1ea6a10420aac0f900b585787d07c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 7 Aug 2024 10:56:57 -0400 Subject: [PATCH 49/77] use field utils to set constant --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 32 +++++------------------ 1 file changed, 6 insertions(+), 26 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 96797303554f..5df11f595782 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -62,6 +62,7 @@ MODULE MAPL_ExtDataGridComp2G use MAPL_ExtDataLogger use MAPL_ExtDataConstants use gFTL_StringIntegerMap + use MAPL_FieldUtils IMPLICIT NONE PRIVATE @@ -1400,39 +1401,18 @@ subroutine set_constant_field(item,ExtDataState,rc) type(ESMF_State), intent(inout) :: extDataState integer, intent(out), optional :: rc - integer :: status,fieldRank - real(kind=REAL32), pointer :: ptr2d(:,:),ptr3d(:,:,:) + integer :: status type(ESMF_Field) :: field if (item%vartype == MAPL_FieldItem) then call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) + call FieldSet(field, item%const, _RC) call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), _RC) - ptr3d = item%const - endif else if (item%vartype == MAPL_VectorField) then call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,_RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), _RC) - ptr3d = item%const - endif - call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,_RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),_RC) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), _RC) - ptr3d = item%const - endif + call FieldSet(field, item%const, _RC) + call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,_RC) + call FieldSet(field, item%const, _RC) end if _RETURN(_SUCCESS) From 063f52c7955ca9fd852f18aa265035945c2e85ef Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Aug 2024 13:36:49 -0400 Subject: [PATCH 50/77] Test adding ifx to CI --- .circleci/config.yml | 16 ++++++++-------- CHANGELOG.md | 2 ++ 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 0a1c854571f0..843ef782b78f 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -21,7 +21,7 @@ bcs_version: &bcs_version v11.5.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: - ci: geos-esm/circleci-tools@2 + ci: geos-esm/circleci-tools@dev:7a293ebb2b990390aa4559ce69af7682bfca2cc1 workflows: build-and-test-MAPL: @@ -33,7 +33,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] cmake_generator: ['Unix Makefiles','Ninja'] baselibs_version: *baselibs_version repo: MAPL @@ -49,7 +49,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] baselibs_version: *baselibs_version repo: MAPL mepodevelop: false @@ -67,7 +67,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] tutorial_name: - hello_world - parent_no_children @@ -89,7 +89,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] baselibs_version: *baselibs_version repo: GEOSgcm checkout_fixture: true @@ -104,7 +104,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm @@ -118,7 +118,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm @@ -136,7 +136,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran,ifort] + compiler: [gfortran, ifort, ifx] baselibs_version: *baselibs_version repo: GEOSldas mepodevelop: false diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b007a0a7842..f8cd96e61de8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) - Update Baselibs in CI to 7.25.0 - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 +- Update to circleci-tools orb v4 + - This adds a new `ifx` CI test - Update `components.yaml` - ESMA_env v4.30.0 - Update to Baselibs 7.25.0 From 1d42fdb8c72a9806a1e38b905b94500496e12e91 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Aug 2024 13:39:27 -0400 Subject: [PATCH 51/77] Fix up CI --- .circleci/config.yml | 21 +++++++++++++++++++-- .github/workflows/workflow.yml | 2 +- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 843ef782b78f..364232f596fe 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -171,7 +171,7 @@ workflows: filters: tags: only: /^v.*$/ - name: publish-intel-docker-image + name: publish-ifort-docker-image context: - docker-hub-creds - ghcr-creds @@ -180,7 +180,24 @@ workflows: container_name: mapl mpi_name: intelmpi mpi_version: "2021.13" - compiler_name: intel + compiler_name: ifort + compiler_version: "2021.13" + image_name: geos-env + tag_build_arg_name: *tag_build_arg_name + - ci/publish_docker: + filters: + tags: + only: /^v.*$/ + name: publish-ifx-docker-image + context: + - docker-hub-creds + - ghcr-creds + os_version: *os_version + baselibs_version: *baselibs_version + container_name: mapl + mpi_name: intelmpi + mpi_version: "2021.13" + compiler_name: ifx compiler_version: "2024.2" image_name: geos-env tag_build_arg_name: *tag_build_arg_name diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 76ed2d251565..d6c9d61fbf4d 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -86,7 +86,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v7.25.0-intelmpi_2021.13-intel_2024.2 + image: gmao/ubuntu20-geos-env:v7.25.0-intelmpi_2021.13-ifort_2021.13 # 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 From 7a32c16de3ddefddfa3924bceb9f191f7705df70 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Aug 2024 14:59:14 -0400 Subject: [PATCH 52/77] Clean up changelog --- CHANGELOG.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f8cd96e61de8..48cd72b808ad 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,10 +15,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added Fortran interface to UDUNITS2 - NOTE: This now means MAPL depends on UDUNITS2 (and transitively, expat) - Improve mask sampler by adding an MPI step and a LS_chunk (intermediate step) -- Update Baselibs in CI to 7.25.0 - - NOTE: The docker image also updates to Intel 2024.2 and Intel MPI 2021.13 -- Update to circleci-tools orb v4 - - This adds a new `ifx` CI test +- CI Updates + - Update Baselibs in CI to 7.25.0 + - Update to circleci-tools orb v4 + - This adds an `ifx` test along with the `ifort` test - Update `components.yaml` - ESMA_env v4.30.0 - Update to Baselibs 7.25.0 From 07ce760f49fd31869df6e50bbe3d2cc4d5da2e99 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 12 Aug 2024 08:13:48 -0400 Subject: [PATCH 53/77] Update bcs in CI --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 364232f596fe..0a0dfe7c4933 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -17,7 +17,7 @@ parameters: # Anchors to prevent forgetting to update a version os_version: &os_version ubuntu20 baselibs_version: &baselibs_version v7.25.0 -bcs_version: &bcs_version v11.5.0 +bcs_version: &bcs_version v11.6.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: From 72e4e7b3da1ad45722e728cb2a579c2622a4369b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 12 Aug 2024 08:52:28 -0400 Subject: [PATCH 54/77] Turn off ifx. Too many errors --- .circleci/config.yml | 48 ++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 0a0dfe7c4933..a108257bc091 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -33,7 +33,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] cmake_generator: ['Unix Makefiles','Ninja'] baselibs_version: *baselibs_version repo: MAPL @@ -49,7 +49,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: MAPL mepodevelop: false @@ -67,7 +67,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] tutorial_name: - hello_world - parent_no_children @@ -89,7 +89,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: GEOSgcm checkout_fixture: true @@ -104,7 +104,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm @@ -118,7 +118,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm @@ -136,7 +136,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort, ifx] + compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: GEOSldas mepodevelop: false @@ -184,23 +184,23 @@ workflows: compiler_version: "2021.13" image_name: geos-env tag_build_arg_name: *tag_build_arg_name - - ci/publish_docker: - filters: - tags: - only: /^v.*$/ - name: publish-ifx-docker-image - context: - - docker-hub-creds - - ghcr-creds - os_version: *os_version - baselibs_version: *baselibs_version - container_name: mapl - mpi_name: intelmpi - mpi_version: "2021.13" - compiler_name: ifx - compiler_version: "2024.2" - image_name: geos-env - tag_build_arg_name: *tag_build_arg_name + #- ci/publish_docker: + #filters: + #tags: + #only: /^v.*$/ + #name: publish-ifx-docker-image + #context: + #- docker-hub-creds + #- ghcr-creds + #os_version: *os_version + #baselibs_version: *baselibs_version + #container_name: mapl + #mpi_name: intelmpi + #mpi_version: "2021.13" + #compiler_name: ifx + #compiler_version: "2024.2" + #image_name: geos-env + #tag_build_arg_name: *tag_build_arg_name - ci/publish_docker: filters: tags: From a41de733bd0f3a572ec48c2999bbf3052bef469c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 12 Aug 2024 12:57:53 -0400 Subject: [PATCH 55/77] Clean up CODEOWNERS --- .github/CODEOWNERS | 8 -------- 1 file changed, 8 deletions(-) diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 49df23351b89..c7f3aedd05bf 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -5,11 +5,3 @@ # The MAPL Team owns all the files * @GEOS-ESM/mapl-team - -# The Python Transition Team will own Python files -# until the Python 3 transition is completed -*.py @GEOS-ESM/python-transition-team - -# The GEOS CMake Team is the CODEOWNER for the CMakeLists.txt files in this repository -CMakeLists.txt @GEOS-ESM/cmake-team - From 8c3a2454c74bafd3597da249aa9b1e8124241af5 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 12 Aug 2024 15:28:19 -0400 Subject: [PATCH 56/77] Clean up NAG + OpenMP CMake --- Apps/CMakeLists.txt | 18 +++---------- CHANGELOG.md | 3 ++- Tests/CMakeLists.txt | 25 ++++--------------- base/CMakeLists.txt | 12 ++------- .../io/checkpoint_simulator/CMakeLists.txt | 7 +----- benchmarks/io/combo/CMakeLists.txt | 7 +----- benchmarks/io/gatherv/CMakeLists.txt | 7 +----- benchmarks/io/raw_bw/CMakeLists.txt | 7 +----- components.yaml | 2 +- docs/tutorial/driver_app/CMakeLists.txt | 5 +--- .../CMakeLists.txt | 6 +---- .../hello_world_gridcomp/CMakeLists.txt | 5 +--- .../grid_comps/leaf_comp_a/CMakeLists.txt | 5 +--- .../grid_comps/leaf_comp_b/CMakeLists.txt | 5 +--- .../parent_with_no_children/CMakeLists.txt | 5 +--- .../parent_with_one_child/CMakeLists.txt | 5 +--- .../parent_with_two_children/CMakeLists.txt | 5 +--- generic/CMakeLists.txt | 8 ++---- gridcomps/Cap/CMakeLists.txt | 6 +---- gridcomps/ExtData/CMakeLists.txt | 6 +---- gridcomps/History/CMakeLists.txt | 7 +----- gridcomps/Orbit/CMakeLists.txt | 7 +----- griddedio/CMakeLists.txt | 6 +---- pfio/CMakeLists.txt | 18 +++---------- pfio/tests/CMakeLists.txt | 11 ++------ profiler/CMakeLists.txt | 6 +---- shared/CMakeLists.txt | 6 +---- 27 files changed, 40 insertions(+), 170 deletions(-) diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt index c0fa7dd74c97..c9e78e434187 100644 --- a/Apps/CMakeLists.txt +++ b/Apps/CMakeLists.txt @@ -26,25 +26,13 @@ install( DESTINATION bin/forcing_converter) ecbuild_add_executable (TARGET Regrid_Util.x SOURCES Regrid_Util.F90) -target_link_libraries (Regrid_Util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (Regrid_Util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (Regrid_Util.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Regrid_Util.x PRIVATE OpenMP::OpenMP_Fortran) -endif () ecbuild_add_executable (TARGET time_ave_util.x SOURCES time_ave_util.F90) -target_link_libraries (time_ave_util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (time_ave_util.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (time_ave_util.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(time_ave_util.x PRIVATE OpenMP::OpenMP_Fortran) -endif () ecbuild_add_executable (TARGET Comp_Testing_Driver.x SOURCES Comp_Testing_Driver.F90) -target_link_libraries (Comp_Testing_Driver.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF) +target_link_libraries (Comp_Testing_Driver.x PRIVATE MAPL MPI::MPI_Fortran ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (Comp_Testing_Driver.x PRIVATE $) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Comp_Testing_Driver.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b007a0a7842..80d037d246e1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -33,10 +33,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops - Move to GEOSpyD Min24.4.4 Python 3.11 - - ESMA_cmake v3.49.0 + - ESMA_cmake v3.50.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs - Add SMOD to submodule generator + - NAG OpenMP Workaround - Add support for preliminary CF Conventions quantization properties - Add new quantization keyword `granular_bitround` to History. This will be the preferred keyword for quantization in the future replacing `GranularBR` diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index 6445f710dc33..e35cec9332d0 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -12,36 +12,21 @@ esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL NetCDF::NetCDF_Fortran if (BUILD_WITH_FARGPARSE) ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ExtDataDriver.F90 ExtDataDriverGridComp.F90 ExtDataDriverMod.F90) - target_link_libraries (ExtDataDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (ExtDataDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(ExtDataDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) target_compile_definitions (ExtDataDriver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) add_subdirectory(ExtData_Testing_Framework EXCLUDE_FROM_ALL) ecbuild_add_executable (TARGET pfio_MAPL_demo.x SOURCES pfio_MAPL_demo.F90) - target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(pfio_MAPL_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + ecbuild_add_executable (TARGET MAPL_demo_fargparse.x SOURCES MAPL_demo_fargparse.F90) - target_link_libraries (MAPL_demo_fargparse.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(MAPL_demo_fargparse.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (MAPL_demo_fargparse.x PRIVATE MAPL FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(MAPL_demo_fargparse.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) ecbuild_add_executable (TARGET CapDriver.x SOURCES CapDriver.F90) - target_link_libraries (CapDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF) - # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 - if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(CapDriver.x PRIVATE OpenMP::OpenMP_Fortran) - endif () + target_link_libraries (CapDriver.x PRIVATE MAPL MAPL.test_utilities FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) set_target_properties(CapDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) endif () diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 8f8945af4771..43ffa5fb4f06 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -71,11 +71,7 @@ esma_add_library( GFTL_SHARED::gftl-shared-v2 GFTL_SHARED::gftl-shared-v1 GFTL::gftl-v2 GFTL::gftl-v1 ESMF::ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) if(DISABLE_GLOBAL_NAME_WARNING) target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) @@ -91,11 +87,7 @@ foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) endforeach() ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS ESMF::ESMF MAPL.shared) -target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(cub2latlon.x PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio MPI::MPI_Fortran OpenMP::OpenMP_Fortran) set_target_properties(cub2latlon.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) if (EXTENDED_SOURCE) diff --git a/benchmarks/io/checkpoint_simulator/CMakeLists.txt b/benchmarks/io/checkpoint_simulator/CMakeLists.txt index 4b08c60fffd6..ae1ad04ce1ba 100644 --- a/benchmarks/io/checkpoint_simulator/CMakeLists.txt +++ b/benchmarks/io/checkpoint_simulator/CMakeLists.txt @@ -6,11 +6,6 @@ ecbuild_add_executable ( SOURCES checkpoint_simulator.F90 DEFINITIONS USE_MPI) -target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse ESMF::ESMF ) +target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${exe} PUBLIC $) set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/combo/CMakeLists.txt b/benchmarks/io/combo/CMakeLists.txt index 99a92e1b46a6..98b096a9515c 100644 --- a/benchmarks/io/combo/CMakeLists.txt +++ b/benchmarks/io/combo/CMakeLists.txt @@ -6,11 +6,6 @@ ecbuild_add_executable ( SOURCES Kernel.F90 GathervKernel.F90 BW_Benchmark.F90 ComboSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (${exe} PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (${exe} PUBLIC $) set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/gatherv/CMakeLists.txt b/benchmarks/io/gatherv/CMakeLists.txt index d6072fb82823..8e053a91ca34 100644 --- a/benchmarks/io/gatherv/CMakeLists.txt +++ b/benchmarks/io/gatherv/CMakeLists.txt @@ -5,11 +5,6 @@ ecbuild_add_executable ( SOURCES GathervKernel.F90 GathervSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (gatherv.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (gatherv.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (gatherv.x PUBLIC $) set_target_properties (gatherv.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(gatherv.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/benchmarks/io/raw_bw/CMakeLists.txt b/benchmarks/io/raw_bw/CMakeLists.txt index 7477ddf6e43f..e27428b2ea1e 100644 --- a/benchmarks/io/raw_bw/CMakeLists.txt +++ b/benchmarks/io/raw_bw/CMakeLists.txt @@ -5,11 +5,6 @@ ecbuild_add_executable ( SOURCES BW_Benchmark.F90 BW_BenchmarkSpec.F90 driver.F90 DEFINITIONS USE_MPI) -target_link_libraries (raw_bw.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse) +target_link_libraries (raw_bw.x PRIVATE MAPL.shared MPI::MPI_Fortran FARGPARSE::fargparse OpenMP::OpenMP_Fortran) target_include_directories (raw_bw.x PUBLIC $) set_target_properties (raw_bw.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(raw_bw.x PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/components.yaml b/components.yaml index 897a4407432e..6f0f71b3e703 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.49.0 + tag: v3.50.0 develop: develop ecbuild: diff --git a/docs/tutorial/driver_app/CMakeLists.txt b/docs/tutorial/driver_app/CMakeLists.txt index 8e758b5c0693..3d1c519863c2 100644 --- a/docs/tutorial/driver_app/CMakeLists.txt +++ b/docs/tutorial/driver_app/CMakeLists.txt @@ -3,9 +3,6 @@ set (srcs ) ecbuild_add_executable (TARGET Example_Driver.x SOURCES ${srcs}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(Example_Driver.x PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(Example_Driver.x PRIVATE MAPL) +target_link_libraries(Example_Driver.x PRIVATE MAPL OpenMP::OpenMP_Fortran) target_compile_definitions (Example_Driver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) diff --git a/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt b/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt index 8422b3a79540..445d474d49a3 100644 --- a/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt +++ b/docs/tutorial/grid_comps/automatic_code_generator_example/CMakeLists.txt @@ -6,7 +6,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) @@ -15,7 +15,3 @@ set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${t mapl_acg (${this} ACG_StateSpecs.rc IMPORT_SPECS EXPORT_SPECS GET_POINTERS DECLARE_POINTERS) - -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () diff --git a/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt b/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt index 0e74c76742a1..a10133e784af 100644 --- a/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt +++ b/docs/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt b/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt index d912da16f28d..89c5fb82c524 100644 --- a/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt +++ b/docs/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt b/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt index e2ae84142283..520e3bfa0e22 100644 --- a/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt +++ b/docs/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt index c9c4299b76bd..3547b1d35434 100644 --- a/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt index b5da305f8e82..db03b5589754 100644 --- a/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt b/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt index 66b39a86a6b3..950f444f315b 100644 --- a/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt +++ b/docs/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt @@ -4,10 +4,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${this} PRIVATE ESMF::ESMF) +target_link_libraries(${this} PRIVATE ESMF::ESMF OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 06b6468771dc..ac1a002ba888 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -69,12 +69,8 @@ esma_add_library(${this} ) target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC ESMF::ESMF NetCDF::NetCDF_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (${this} PUBLIC ESMF::ESMF NetCDF::NetCDF_Fortran + PRIVATE OpenMP::OpenMP_Fortran) if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 20b70e3953fd..8481a9dec79e 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -17,16 +17,12 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history MAPL.ExtData ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran $<$:FLAP::FLAP> $<$:FARGPARSE::fargparse>) target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/ExtData/CMakeLists.txt b/gridcomps/ExtData/CMakeLists.txt index 51ccf7a3a3be..cbc46e446070 100644 --- a/gridcomps/ExtData/CMakeLists.txt +++ b/gridcomps/ExtData/CMakeLists.txt @@ -9,12 +9,8 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.pfio MAPL.griddedio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/History/CMakeLists.txt b/gridcomps/History/CMakeLists.txt index 58af30a30b27..e470a5dddca2 100644 --- a/gridcomps/History/CMakeLists.txt +++ b/gridcomps/History/CMakeLists.txt @@ -14,12 +14,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.profiler MAPL.griddedio TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/Orbit/CMakeLists.txt b/gridcomps/Orbit/CMakeLists.txt index ed51cb1e23cb..09c8c5080337 100644 --- a/gridcomps/Orbit/CMakeLists.txt +++ b/gridcomps/Orbit/CMakeLists.txt @@ -6,12 +6,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/griddedio/CMakeLists.txt b/griddedio/CMakeLists.txt index db7322918aef..bcf44d0be3f8 100644 --- a/griddedio/CMakeLists.txt +++ b/griddedio/CMakeLists.txt @@ -13,12 +13,8 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.pfio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF::ESMF NetCDF::NetCDF_Fortran - PRIVATE MPI::MPI_Fortran) + PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index 15390fb324e5..3c64d0598926 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -22,7 +22,7 @@ set (srcs FileMetadata.F90 FileMetadataVector.F90 NetCDF4_FileFormatter.F90 - pfio_nf90_supplement.c + pfio_nf90_supplement.c NetCDF_Supplement.F90 pFIO_Utilities.F90 pFIO.F90 @@ -120,11 +120,7 @@ endif () esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl-v2 GFTL_SHARED::gftl-shared-v2 PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries (${this} PUBLIC GFTL::gftl-v2 GFTL_SHARED::gftl-shared-v2 PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) @@ -150,20 +146,14 @@ ecbuild_add_executable ( SOURCES pfio_server_demo.F90 LIBS ${this} MPI::MPI_Fortran) set_target_properties (pfio_server_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_server_demo.x OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(pfio_server_demo.x OpenMP::OpenMP_Fortran) ecbuild_add_executable ( TARGET pfio_collective_demo.x SOURCES pfio_collective_demo.F90 LIBS ${this} MPI::MPI_Fortran) set_target_properties (pfio_collective_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(pfio_collective_demo.x OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(pfio_collective_demo.x OpenMP::OpenMP_Fortran) ecbuild_add_executable ( TARGET pfio_writer.x diff --git a/pfio/tests/CMakeLists.txt b/pfio/tests/CMakeLists.txt index 29fe0153030e..8d7b9b077d4b 100644 --- a/pfio/tests/CMakeLists.txt +++ b/pfio/tests/CMakeLists.txt @@ -64,10 +64,7 @@ ecbuild_add_executable ( SOURCES pfio_ctest_io.F90 LIBS MAPL.shared MAPL.pfio NetCDF::NetCDF_Fortran MPI::MPI_Fortran DEFINITIONS USE_MPI) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${TESTO} OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${TESTO} OpenMP::OpenMP_Fortran) set_target_properties(${TESTO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) # Detect if we are using Open MPI and add oversubscribe @@ -126,11 +123,7 @@ ecbuild_add_executable ( SOURCES pfio_performance.F90 DEFINITIONS USE_MPI LIBS MAPL.pfio NetCDF::NetCDF_Fortran MPI::MPI_Fortran) -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${TESTPERF} OpenMP::OpenMP_Fortran) -endif () -target_link_libraries(${TESTPERF} MAPL.pfio NetCDF::NetCDF_Fortran) +target_link_libraries(${TESTPERF} MAPL.pfio NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran) set_target_properties(${TESTPERF} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) add_test(NAME pFIO_performance diff --git a/profiler/CMakeLists.txt b/profiler/CMakeLists.txt index b3d17fce4219..259b45748d43 100644 --- a/profiler/CMakeLists.txt +++ b/profiler/CMakeLists.txt @@ -51,11 +51,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES GFTL_SHARED::gftl-shared GFTL::gftl-v1 GFTL::gftl-v2 MAPL.shared MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) target_include_directories (${this} PRIVATE ${MAPL_SOURCE_DIR}/include) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) add_subdirectory (demo EXCLUDE_FROM_ALL) if (PFUNIT_FOUND) diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 94f9336e8c79..a1b88404dd40 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -35,11 +35,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.constants GFTL_SHARED::gftl-shared MPI::MPI_Fortran PFLOGGER::pflogger TYPE ${MAPL_LIBRARY_TYPE}) - -# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 -if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") - target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) -endif () +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) target_include_directories (${this} PUBLIC $) From 686993a7e3e8550a4d5e58a6b2ef68ca4efb2244 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 13 Aug 2024 10:06:09 -0400 Subject: [PATCH 57/77] fix bug in previous commit --- gridcomps/Cap/MAPL_CapGridComp.F90 | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index cf3e385e29e2..5f09f36ca6fc 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -425,7 +425,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%cf_root = ESMF_ConfigCreate(_RC ) call ESMF_ConfigLoadFile(cap%cf_root, ROOT_CF, _RC ) - call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and root RUN_DT (%g0)', heartbeat_dt, run_dt) @@ -506,7 +506,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%cf_ext = ESMF_ConfigCreate(_RC ) call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, _RC ) - call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) @@ -652,18 +652,13 @@ subroutine initialize_extdata(cap , root_gc, rc) do while(iter /= cap_exports_vec%end()) component_name = iter%get() component_name = trim(component_name(index(component_name, ",")+1:)) - field_name = iter%get() field_name = trim(field_name(1:index(field_name, ",")-1)) - call MAPL_ExportStateGet([cap%child_exports(cap%root_id)], component_name, & component_state, status) _VERIFY(status) - call ESMF_StateGet(component_state, trim(field_name), field, _RC) - call MAPL_StateAdd(cap%export_state, field, _RC) - call iter%next() end do end if @@ -699,7 +694,6 @@ subroutine initialize_extdata(cap , root_gc, rc) else state = cap%child_exports(cap%extdata_id) end if - if (item_types(i) == ESMF_StateItem_Field) then call ESMF_StateGet(root_imports, item_names(i), field, _RC) call MAPL_AddAttributeToFields(root_gc,trim(item_names(i)),'RESTART',MAPL_RestartSkip,_RC) @@ -993,6 +987,7 @@ function get_vec_from_config(config, key, rc) result(vec) if (trim(cap_import) /= "::") call vec%push_back(trim(cap_import)) end do end if + _RETURN(_SUCCESS) end function get_vec_from_config @@ -1342,7 +1337,7 @@ subroutine set_grid(this, grid, unusable, lm, grid_type, rc) external_grid_factory = ExternalGridFactory(grid=grid, lm=lm, _RC) mapl_grid = grid_manager%make_grid(external_grid_factory, _RC) ! grid_type is an optional parameter that allows GridType to be set explicitly. - call ESMF_ConfigGetAttribute(this%config, value = grid_type_, Label="GridType:", default="", _RC) + call ESMF_ConfigGetAttribute(this%config, value = grid_type_, Label="GridType:", default="", rc=status) if (status == ESMF_RC_OBJ_NOT_CREATED) then grid_type_ = "" else From 58a1798729051fba8619be6a2a94fcb0210219ab Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 16 Aug 2024 16:02:01 -0400 Subject: [PATCH 58/77] ifixes #2969 --- base/MAPL_VerticalMethods.F90 | 83 ++++++++++++------------------ generic/CMakeLists.txt | 1 - generic/ComponentSpecification.F90 | 1 - generic/MAPL_Generic.F90 | 9 +++- generic/MaplGeneric.F90 | 1 - generic/StateSpecification.F90 | 12 ++++- generic/VarSpec.F90 | 16 ++++++ generic/VarSpecMiscMod.F90 | 1 - generic/VarSpecType.F90 | 10 ++++ generic/VariableSpecification.F90 | 10 ---- 10 files changed, 79 insertions(+), 65 deletions(-) delete mode 100644 generic/VariableSpecification.F90 diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 6c412c16b28b..205e3c6416f3 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -166,8 +166,7 @@ function skip_var(this,field,rc) result(skip) integer :: status character(len=ESMF_MAXSTR) :: name - call ESMF_FieldGet(field,name=name,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,name=name,_RC) skip = trim(name)==trim(this%vvar) end function skip_var @@ -185,8 +184,7 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc) if (allocated(this%ple3d)) deallocate(this%ple3d) if (allocated(this%pl3d)) deallocate(this%pl3d) - call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,rc=status) - _VERIFY(status) + call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,_RC) allocate(orig_surface_level(size(ptr3,1),size(ptr3,2)),stat=status) _VERIFY(status) @@ -242,16 +240,14 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc) end if if (present(output_grid)) then _ASSERT(present(regrid_handle),"Must provide regridding handle") - call MAPL_GridGet(output_grid,localCellCountPerDim=counts,rc=status) - _VERIFY(status) + call MAPL_GridGet(output_grid,localCellCountPerDim=counts,_RC) if (.not.allocated(this%surface_level)) then allocate(this%surface_level(counts(1),counts(2)),stat=status) _VERIFY(status) end if end if if (present(regrid_handle)) then - call regrid_handle%regrid(orig_surface_level,this%surface_level,rc=status) - _VERIFY(status) + call regrid_handle%regrid(orig_surface_level,this%surface_level,_RC) end if deallocate(orig_surface_level) @@ -411,11 +407,9 @@ subroutine correct_topo(this,field,rc) call ESMF_FieldGet(field,grid=grid,_RC) has_de = MAPL_GridHasDE(grid,_RC) if (has_de) then - call ESMF_FieldGet(field,rank=rank,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,rank=rank,_RC) if (rank==3) then - call ESMF_FieldGet(field,0,farrayptr=ptr,rc=status) - _VERIFY(status) + call ESMF_FieldGet(field,0,farrayptr=ptr,_RC) do k=1,size(ptr,3) if (this%ascending) then where(this%surface_level NULL() logical :: usableDEPENDS_ON_CHILDREN + character(len=positive_length) :: usablePositive ! character (len=:), allocatable :: usableDEPENDS_ON(:) INTEGER :: I @@ -413,6 +416,12 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & usableUNGRIDDED_COORDS = UNGRIDDED_COORDS end if + if (present(POSITIVE)) then + usablePositive = positive + else + usablePositive = 'down' + end if + I = spec%var_specs%size() allocate(tmp%specptr) @@ -444,6 +453,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, & TMP%SPECPTR%ROTATION = usableROTATION TMP%SPECPTR%doNotAllocate = .false. TMP%SPECPTR%alwaysAllocate = .false. + TMP%SPECPTR%positive = usablePositive if(associated(usableATTR_IVALUES)) then TMP%SPECPTR%ATTR_IVALUES => usableATTR_IVALUES else diff --git a/generic/VarSpec.F90 b/generic/VarSpec.F90 index c85d4f325c16..646368eb9d3c 100644 --- a/generic/VarSpec.F90 +++ b/generic/VarSpec.F90 @@ -97,6 +97,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & STAGGERING, & ROTATION, & GRID, & + positive, & RC ) type (MAPL_VarSpec ), pointer :: SPEC(:) @@ -130,6 +131,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & integer , optional , intent(IN) :: STAGGERING integer , optional , intent(IN) :: ROTATION type(ESMF_Grid) , optional , intent(IN) :: GRID + character(len=positive_length), optional, intent(in) :: positive integer , optional , intent(OUT) :: RC @@ -151,6 +153,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & integer :: usableSTAGGERING integer :: usableROTATION integer :: usableRESTART + character(len=positive_length) :: usablePositive character(len=ESMF_MAXSTR) :: usableLONG character(len=ESMF_MAXSTR) :: usableUNIT character(len=ESMF_MAXSTR) :: usableFRIENDLYTO @@ -410,6 +413,12 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & usableUNGRIDDED_COORDS = UNGRIDDED_COORDS end if + if (present(positive)) then + usablePositive = positive + else + usablePositive = 'down' + end if + I = size(SPEC) allocate(TMP(I+1),stat=STATUS) @@ -447,6 +456,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & TMP(I+1)%SPECPtr%UNGRIDDED_NAME = useableUngrd_Name TMP(I+1)%SPECPtr%STAGGERING = usableSTAGGERING TMP(I+1)%SPECPtr%ROTATION = usableROTATION + TMP(I+1)%SPECPtr%positive= usablePositive TMP(I+1)%SPECPtr%doNotAllocate = .false. TMP(I+1)%SPECPtr%alwaysAllocate = .false. if(associated(usableATTR_IVALUES)) then @@ -803,6 +813,7 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & alwaysAllocate, & depends_on_children, & depends_on, & + positive, & RC ) type (MAPL_VarSpec ), intent(IN ) :: SPEC @@ -842,6 +853,7 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & logical , optional , intent(OUT) :: alwaysAllocate logical , optional , intent(OUT) :: depends_on_children character(len=:), allocatable, optional, intent(OUT) :: depends_on(:) + character(len=*), optional, intent(out) :: positive integer , optional , intent(OUT) :: RC @@ -997,6 +1009,10 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & end if end if + if(present(positive)) then + positive = SPEC%SPECPtr%positive + end if + _RETURN(ESMF_SUCCESS) end subroutine MAPL_VarSpecGetRegular diff --git a/generic/VarSpecMiscMod.F90 b/generic/VarSpecMiscMod.F90 index 49e95d70008e..6e3e5463e185 100644 --- a/generic/VarSpecMiscMod.F90 +++ b/generic/VarSpecMiscMod.F90 @@ -15,7 +15,6 @@ module MAPL_VarSpecMiscMod use pFlogger use MAPL_Constants use MAPL_ExceptionHandling - use mapl_VariableSpecification use mapl_VarSpecVector use mapl_VarConnVector use MAPL_VarSpecTypeMod diff --git a/generic/VarSpecType.F90 b/generic/VarSpecType.F90 index c22ebe014e47..43864ab4f400 100644 --- a/generic/VarSpecType.F90 +++ b/generic/VarSpecType.F90 @@ -18,6 +18,9 @@ module MAPL_VarSpecTypeMod public :: MAPL_VarSpecType public :: MAPL_VarSpecSet + public :: positive_length + + integer, parameter :: positive_length = 4 type :: MAPL_VarSpecType ! new @@ -36,6 +39,7 @@ module MAPL_VarSpecTypeMod integer, pointer :: UNGRIDDED_DIMS(:) => null() character(len=ESMF_MAXSTR) :: UNGRIDDED_UNIT character(len=ESMF_MAXSTR) :: UNGRIDDED_NAME + character(len=positive_length) :: positive real, pointer :: UNGRIDDED_COORDS(:) integer :: DIMS integer :: LOCATION @@ -84,6 +88,7 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & grid, & donotallocate, & alwaysallocate, & + positive, & rc ) class(mapl_varspectype), intent(inout) :: spec @@ -107,6 +112,7 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & type(ESMF_grid) , optional , intent(in) :: grid logical , optional , intent(in) :: donotallocate logical , optional , intent(in) :: alwaysallocate + character(len=positive_length), optional, intent(in) :: positive integer , optional , intent(out) :: rc @@ -191,6 +197,10 @@ subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & spec%alwaysallocate = alwaysallocate endif + if(present(positive)) then + spec%positive = positive + endif + associate( & horz_spec => create_horz_stagger_spec(spec), & vert_spec => create_vert_stagger_spec(spec), & diff --git a/generic/VariableSpecification.F90 b/generic/VariableSpecification.F90 deleted file mode 100644 index 5ec659374a70..000000000000 --- a/generic/VariableSpecification.F90 +++ /dev/null @@ -1,10 +0,0 @@ -module mapl_VariableSpecification - use ESMF - use MAPL_VarSpecTypeMod - use MAPL_VarSpecMod - use MAPL_VarSpecPtrMod - implicit none - private - - -end module mapl_VariableSpecification From eae35b6c8a582dd47eaf4c5e67654db7a6ebfd63 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 23 Aug 2024 13:47:52 -0400 Subject: [PATCH 59/77] Update to v4 orb --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index a108257bc091..0de92fb286bb 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -21,7 +21,7 @@ bcs_version: &bcs_version v11.6.0 tag_build_arg_name: &tag_build_arg_name maplversion orbs: - ci: geos-esm/circleci-tools@dev:7a293ebb2b990390aa4559ce69af7682bfca2cc1 + ci: geos-esm/circleci-tools@4 workflows: build-and-test-MAPL: From 3ab3950f5c61c66813b2be89b22877031ebd1b08 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 23 Aug 2024 13:49:14 -0400 Subject: [PATCH 60/77] Clarify changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 38ecf293a14b..9a376b7ece9e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,7 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - CI Updates - Update Baselibs in CI to 7.25.0 - Update to circleci-tools orb v4 - - This adds an `ifx` test along with the `ifort` test + - This adds the ability to do an `ifx` test along with the `ifort` test (though `ifx` is not yet enabled) - Update `components.yaml` - ESMA_env v4.30.0 - Update to Baselibs 7.25.0 From 141c8f141888f9ac18b6783433b72e749e893a48 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 26 Aug 2024 11:14:40 -0400 Subject: [PATCH 61/77] updated changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9a376b7ece9e..f06b339e7036 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file - Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x - Added Fortran interface to UDUNITS2 - NOTE: This now means MAPL depends on UDUNITS2 (and transitively, expat) From eb5b58ccfd9de44a5b58ad5112c8b51d918e7086 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 26 Aug 2024 11:44:29 -0400 Subject: [PATCH 62/77] fix bug --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 5df11f595782..60813a6c3512 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -1407,7 +1407,6 @@ subroutine set_constant_field(item,ExtDataState,rc) if (item%vartype == MAPL_FieldItem) then call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) call FieldSet(field, item%const, _RC) - call ESMF_FieldGet(field,dimCount=fieldRank,_RC) else if (item%vartype == MAPL_VectorField) then call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,_RC) call FieldSet(field, item%const, _RC) From 17e6a0f6f3d977e969e392a19e7582f8ca93cea9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 5 Sep 2024 10:25:19 -0400 Subject: [PATCH 63/77] Update to ESMA_cmake v3.51.0 --- CHANGELOG.md | 3 ++- components.yaml | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f06b339e7036..aa0fcfa200de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,11 +36,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops - Move to GEOSpyD Min24.4.4 Python 3.11 - - ESMA_cmake v3.50.0 + - ESMA_cmake v3.51.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs - Add SMOD to submodule generator - NAG OpenMP Workaround + - Support for Jemalloc and LLVM Flang - Add support for preliminary CF Conventions quantization properties - Add new quantization keyword `granular_bitround` to History. This will be the preferred keyword for quantization in the future replacing `GranularBR` diff --git a/components.yaml b/components.yaml index 6f0f71b3e703..ebbcf04816fc 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.50.0 + tag: v3.51.0 develop: develop ecbuild: From a20827d48721b436e92773f9171ce5016f5c9e98 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 6 Sep 2024 10:39:35 -0400 Subject: [PATCH 64/77] use containers instead of allocatable pointer ... --- gridcomps/ExtData2G/CMakeLists.txt | 2 + .../ExtData2G/ExtDataDerivedExportVector.F90 | 13 + gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 324 ++++++++---------- .../ExtData2G/ExtDataOldTypesCreator.F90 | 13 +- .../ExtData2G/ExtDataPrimaryExportVector.F90 | 13 + gridcomps/ExtData2G/ExtDataTypeDef.F90 | 4 - 6 files changed, 170 insertions(+), 199 deletions(-) create mode 100644 gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 create mode 100644 gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 52f6507fe5ae..9f4d4dbc6dbe 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -20,6 +20,8 @@ set (srcs ExtData_IOBundleMod.F90 ExtData_IOBundleVectorMod.F90 ExtDataMasking.F90 + ExtDataPrimaryExportVector.F90 + ExtDataDerivedExportVector.F90 ) diff --git a/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 b/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 new file mode 100644 index 000000000000..d7be690c30a4 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataDerivedExportVector.F90 @@ -0,0 +1,13 @@ +module MAPL_ExtDataDerivedExportVectorMod + use MAPL_ExtDataTypeDef +#define T DerivedExport +#define Vector DerivedExportVector +#define VectorIterator DerivedExportVectorIterator + +#include "vector/template.inc" + +#undef T +#undef Vector +#undef VectorIterator + +end module MAPL_ExtDataDerivedExportVectorMod diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 60813a6c3512..542199a2edc9 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -63,6 +63,8 @@ MODULE MAPL_ExtDataGridComp2G use MAPL_ExtDataConstants use gFTL_StringIntegerMap use MAPL_FieldUtils + use MAPL_ExtDataPrimaryExportVectorMod + use MAPL_ExtDataDerivedExportVectorMod IMPLICIT NONE PRIVATE @@ -79,20 +81,18 @@ MODULE MAPL_ExtDataGridComp2G type PrimaryExports PRIVATE - integer :: nItems = 0 type(integerVector) :: export_id_start type(integerVector) :: number_of_rules type(stringVector) :: import_names - type(PrimaryExport), pointer :: item(:) => null() + type(PrimaryExportVector) :: item_vec contains procedure :: get_item_index end type PrimaryExports type DerivedExports PRIVATE - integer :: nItems = 0 type(stringVector) :: import_names - type(DerivedExport), pointer :: item(:) => null() + type(DerivedExportVector) :: item_vec end type DerivedExports ! Legacy state @@ -249,6 +249,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) character(len=1) :: sidx type(ESMF_VM) :: vm type(ESMF_StateItem_Flag) :: state_item_type + type(PrimaryExport), allocatable :: temp_item + type(DerivedExport), allocatable :: derived_item !class(logger), pointer :: lgr ! Get my name and set-up traceback handle @@ -340,11 +342,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _FAIL("Unsatisfied imports in ExtData") end if - allocate(self%primary%item(PrimaryItemCount),__STAT__) - allocate(self%derived%item(DerivedItemCount),__STAT__) - self%primary%nitems = PrimaryItemCount - self%derived%nitems = DerivedItemCount - num_primary=0 num_derived=0 do i=1,self%primary%import_names%size() @@ -360,15 +357,21 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do j=1,num_rules num_primary=num_primary+1 write(sidx,'(I1)')j - call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,_RC) + allocate(temp_item) + call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,temp_item,time,clock,_RC) _ASSERT(status==0, "ExtData multi-rule problem with BASE NAME "//TRIM(current_base_name)) - allocate(self%primary%item(num_primary)%start_end_time(2)) - self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) - self%primary%item(num_primary)%start_end_time(2)=time_ranges(j+1) + allocate(temp_item%start_end_time(2)) + temp_item%start_end_time(1)=time_ranges(j) + temp_item%start_end_time(2)=time_ranges(j+1) + call self%primary%item_vec%push_back(temp_item) + deallocate(temp_item) enddo else num_primary=num_primary+1 - call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,_RC) + allocate(temp_item) + call config_yaml%fillin_primary(current_base_name,current_base_name,temp_item,time,clock,_RC) + call self%primary%item_vec%push_back(temp_item) + deallocate(temp_item) _ASSERT(status==0, "ExtData single-rule problem with BASE NAME "//TRIM(current_base_name)) end if call ESMF_StateGet(Export,current_base_name,state_item_type,_RC) @@ -377,7 +380,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_StateAdd(self%ExtDataState,field,_RC) item_type = config_yaml%get_item_type(current_base_name) if (item_type == Primary_Type_Vector_comp1) then - call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) + item => self%primary%item_vec%at(num_primary) + call ESMF_StateGet(Export,item%vcomp2,field,_RC) call MAPL_StateAdd(self%ExtDataState,field,_RC) end if end if @@ -385,16 +389,22 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do i=1,self%derived%import_names%size() current_base_name => self%derived%import_names%at(i) num_derived=num_derived+1 - call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,_RC) + allocate(derived_item) + !call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,_RC) + call config_yaml%fillin_derived(current_base_name,derived_item,time,clock,_RC) + call self%derived%item_vec%push_back(derived_item) call ESMF_StateGet(Export,current_base_name,field,_RC) call MAPL_StateAdd(self%ExtDataState,field,_RC) + deallocate(derived_item) enddo + ! now see if we have to allocate any primary fields due to a derived item + ! also see if we have to allocate any primary fields due to PS PrimaryLoop: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) item%pfioCOllection_id = MAPL_DataAddCollection(item%file_template) call create_primary_field(item,self%ExtDataState,time,_RC) @@ -514,9 +524,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Fill in the internal state with data from the files ! --------------------------------------------------- - allocate(do_pointer_update(self%primary%nitems),_STAT) + allocate(do_pointer_update(self%primary%item_vec%size()),_STAT) do_pointer_update = .false. - allocate(useTime(self%primary%nitems),_STAT) + allocate(useTime(self%primary%item_vec%size()),_STAT) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") @@ -527,7 +537,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,current_time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) if (.not.item%initialized) then item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) @@ -574,7 +584,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) bracket_side = io_bundle%bracket_side entry_num = io_bundle%entry_index file_Processed = io_bundle%file_name - item => self%primary%item(entry_num) + item => self%primary%item_vec%at(entry_num) io_bundle%pbundle = ESMF_FieldBundleCreate(_RC) @@ -602,15 +612,15 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") - bundle_iter = IOBundles%begin() - do while (bundle_iter /= IOBundles%end()) - io_bundle => bundle_iter%get() - bracket_side = io_bundle%bracket_side - entry_num = io_bundle%entry_index - item => self%primary%item(entry_num) - call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) - call bundle_iter%next() - enddo + !bundle_iter = IOBundles%begin() + !do while (bundle_iter /= IOBundles%end()) + !io_bundle => bundle_iter%get() + !bracket_side = io_bundle%bracket_side + !entry_num = io_bundle%entry_index + !item => self%primary%item(entry_num) + !call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) + !call bundle_iter%next() + !enddo call MAPL_ExtDataDestroyCFIO(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") @@ -623,7 +633,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,current_time,_RC) - item => self%primary%item(idx) + item => self%primary%item_vec%at(idx) if (do_pointer_update(i)) then @@ -643,9 +653,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"-Interpolate") ! now take care of derived fields - do i=1,self%derived%nItems + do i=1,self%derived%item_vec%size() - derivedItem => self%derived%item(i) + derivedItem => self%derived%item_vec%at(i) call derivedItem%update_freq%check_update(doUpdate_,use_time,current_time,.not.hasRun,_RC) @@ -705,17 +715,6 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! --------------------- call MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, _RC ) -! Extract relevant runtime information -! ------------------------------------ - call extract_ ( GC, self, CF, _RC) - -! Free the memory used to hold the primary export items -! ----------------------------------------------------- - if (associated(self%primary%item)) then - deallocate(self%primary%item) - end if - - ! All done ! -------- _RETURN(ESMF_SUCCESS) @@ -805,7 +804,7 @@ subroutine GetLevs(item, rc) positive=>null() var => null() - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then var=>item%file_metadata%get_variable(trim(item%fcomp1)) _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file_template)) var => null() @@ -842,7 +841,7 @@ subroutine GetLevs(item, rc) enddo end if if (trim(item%levunit)=='hpa') item%levs=item%levs*100.0 - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",_RC) else item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",_RC) @@ -874,62 +873,62 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataInterpField - subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) - type(MAPL_ExtData_State), intent(inout) :: ExtState - type(PrimaryExport), intent(inout) :: item - integer, intent(in ) :: filec - type(ESMF_Time), intent(in ) :: current_time - integer, optional, intent(out ) :: rc - - integer :: status - integer :: id_ps - type(ESMF_Field) :: field, newfield,psF - - if (item%do_VertInterp) then - if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,_RC) - end if - if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,_RC) - id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - - else if (item%vartype == MAPL_VectorField) then - - id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) - call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - - end if - - else if (item%do_Fill) then - if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,_RC) - call MAPL_ExtDataFillField(item,field,newfield,_RC) - else if (item%vartype == MAPL_VectorField) then - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) - call MAPL_ExtDataFillField(item,field,newfield,_RC) - call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) - call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) - call MAPL_ExtDataFillField(item,field,newfield,_RC) - end if - else - if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(item,filec,_RC) - end if - end if - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_ExtDataVerticalInterpolate + !subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) + !type(MAPL_ExtData_State), intent(inout) :: ExtState + !type(PrimaryExport), intent(inout) :: item + !integer, intent(in ) :: filec + !type(ESMF_Time), intent(in ) :: current_time + !integer, optional, intent(out ) :: rc + + !integer :: status + !integer :: id_ps + !type(ESMF_Field) :: field, newfield,psF + + !if (item%do_VertInterp) then + !if (trim(item%importVDir)/=trim(item%fileVDir)) then + !call MAPL_ExtDataFlipVertical(item,filec,_RC) + !end if + !if (item%vartype == MAPL_fieldItem) then + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + !id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) + !call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) + !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + + !else if (item%vartype == MAPL_VectorField) then + + !id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) + !call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + + !end if + + !else if (item%do_Fill) then + !if (item%vartype == MAPL_fieldItem) then + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + !call MAPL_ExtDataFillField(item,field,newfield,_RC) + !else if (item%vartype == MAPL_VectorField) then + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + !call MAPL_ExtDataFillField(item,field,newfield,_RC) + !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + !call MAPL_ExtDataFillField(item,field,newfield,_RC) + !end if + !else + !if (trim(item%importVDir)/=trim(item%fileVDir)) then + !call MAPL_ExtDataFlipVertical(item,filec,_RC) + !end if + !end if + + !_RETURN(ESMF_SUCCESS) + !end subroutine MAPL_ExtDataVerticalInterpolate function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) @@ -1021,37 +1020,17 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then - if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then - if (getRL_) then - call item%modelGridFields%auxiliary2%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp2%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp2%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then - if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then - if (getRL_) then - call item%modelGridFields%auxiliary2%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp2%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp2%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) end if else if (present(bundle)) then @@ -1062,21 +1041,11 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then if (Bside == MAPL_ExtDataLeft) then - if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) else if (Bside == MAPL_ExtDataRight) then - if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - else - call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) - end if + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) end if else if (present(bundle)) then !if (Bside == MAPL_ExtDataLeft) then @@ -1150,15 +1119,10 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) real, allocatable :: ptemp(:,:,:) integer :: ls, le - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) call ESMF_FieldGet(Field1,0,farrayPtr=ptr,_RC) allocate(ptemp,source=ptr,_STAT) @@ -1174,11 +1138,7 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) else - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) call ESMF_FieldGet(Field,0,farrayPtr=ptr,_RC) allocate(ptemp,source=ptr,_STAT) @@ -1202,15 +1162,10 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid - if (item%isVector) then + if (item%vartype == MAPL_VectorField) then - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) call ESMF_FieldGet(Field1,grid=grid,_RC) call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) @@ -1219,11 +1174,7 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) else - if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) - else - call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) - end if + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) call ESMF_FieldGet(Field,grid=grid,_RC) call ESMF_FieldBundleSet(pbundle,grid=grid,_RC) @@ -1334,19 +1285,20 @@ subroutine createFileLevBracket(item,cf,rc) type (ESMF_Grid) :: grid, newgrid type(ESMF_Field) :: field,new_field - call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,_RC) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) - call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,_RC) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) - call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,_RC) - if (item%vartype==MAPL_VectorField) then - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) - call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,_RC) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) - call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,_RC) - end if - _RETURN(_SUCCESS) + _FAIL('you be bad') + !call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + !newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,_RC) + !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + !call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,_RC) + !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + !call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,_RC) + !if (item%vartype==MAPL_VectorField) then + !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + !call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,_RC) + !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + !call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,_RC) + !end if + !_RETURN(_SUCCESS) end subroutine createFileLevBracket @@ -1626,6 +1578,7 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) integer :: i integer, pointer :: num_rules,i_start logical :: found + type(PrimaryExport), pointer :: item found = .false. do i=1,this%import_names%size() @@ -1644,8 +1597,9 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) item_index = i_start else if (num_rules > 1) then do i=1,num_rules - if (current_time >= this%item(i_start+i-1)%start_end_time(1) .and. & - current_time < this%item(i_start+i-1)%start_end_time(2)) then + item => this%item_vec%at(i_start+i-1) + if (current_time >= item%start_end_time(1) .and. & + current_time < item%start_end_time(2)) then item_index = i_start + i -1 exit endif diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index af453e701f5b..73015ec07363 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -82,13 +82,10 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa call default_time_sample%set_defaults() time_sample=>default_time_sample end if - primary_item%isVector = allocated(rule%vector_partner) - ! name and file var - !primary_item%name = trim(item_name) + primary_item%vartype = MAPL_FieldItem + if (allocated(rule%vector_partner)) primary_item%vartype = MAPL_VectorField primary_item%name = trim(base_name) - if (primary_item%isVector) then - primary_item%vartype = MAPL_VectorField - !primary_item%vcomp1 = trim(item_name) + if (primary_item%vartype == MAPL_VectorField) then primary_item%vcomp1 = trim(base_name) primary_item%vcomp2 = trim(rule%vector_partner) primary_item%var = rule%file_var @@ -98,8 +95,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa primary_item%fileVars%xname = trim(rule%file_var) primary_item%fileVars%yname = trim(rule%vector_file_partner) else - primary_item%vartype = MAPL_FieldItem - !primary_item%vcomp1 = trim(item_name) primary_item%vcomp1 = trim(base_name) primary_item%var = rule%file_var primary_item%fcomp1 = rule%file_var @@ -136,8 +131,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa call primary_item%modelGridFields%comp1%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation,exact=exact) call primary_item%modelGridFields%comp2%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation,exact=exact) - call primary_item%modelGridFields%auxiliary1%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation,exact=exact) - call primary_item%modelGridFields%auxiliary2%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation,exact=exact) ! file_template primary_item%isConst = .false. diff --git a/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 b/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 new file mode 100644 index 000000000000..b6eb6aaed9a7 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataPrimaryExportVector.F90 @@ -0,0 +1,13 @@ +module MAPL_ExtDataPrimaryExportVectorMod + use MAPL_ExtDataTypeDef +#define T PrimaryExport +#define Vector PrimaryExportVector +#define VectorIterator PrimaryExportVectorIterator + +#include "vector/template.inc" + +#undef T +#undef Vector +#undef VectorIterator + +end module MAPL_ExtDataPrimaryExportVectorMod diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index e34d9c1a2907..295f979b7a9b 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -20,9 +20,6 @@ module MAPL_ExtDataTypeDef ! fields to store endpoints for interpolation of a vector pair type(ExtDataBracket) :: comp1 type(ExtDataBracket) :: comp2 - ! if vertically interpolating vector fields - type(ExtDataBracket) :: auxiliary1 - type(ExtDataBracket) :: auxiliary2 logical :: initialized = .false. end type BracketingFields @@ -40,7 +37,6 @@ module MAPL_ExtDataTypeDef class(ExtDataAbstractFileHandler), allocatable :: filestream ! if primary export represents a pair of vector fields - logical :: isVector type(BracketingFields) :: modelGridFields ! names of the two vector components in the gridded component where import is declared From 3915a1baa8552a3692d861e3dafdecf21d38a4cc Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 6 Sep 2024 11:12:36 -0400 Subject: [PATCH 65/77] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f06b339e7036..e4823a4ceb17 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Start implementing changes for vertical regridding in ExtData - Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file - Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x - Added Fortran interface to UDUNITS2 From 6ded3871a98e31d256e8ddf9c9afcbb881a879f2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 9 Sep 2024 10:26:32 -0400 Subject: [PATCH 66/77] Update to ESMA_env v4.30.1 --- CHANGELOG.md | 3 ++- components.yaml | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 67e53bfa32e5..c48ef20b3d58 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 - Update to circleci-tools orb v4 - This adds the ability to do an `ifx` test along with the `ifort` test (though `ifx` is not yet enabled) - Update `components.yaml` - - ESMA_env v4.30.0 + - ESMA_env v4.30.1 - Update to Baselibs 7.25.0 - ESMF 8.6.1 - GFE v1.16.0 @@ -37,6 +37,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Move to use Intel ifort 2021.13 at NCCS SLES15, NAS, and GMAO Desktops - Move to use Intel MPI at NCCS SLES15 and GMAO Desktops - Move to GEOSpyD Min24.4.4 Python 3.11 + - Fix for csh at NAS - ESMA_cmake v3.51.0 - Update `esma_add_fortran_submodules` function - Move MPI detection out of FindBaselibs diff --git a/components.yaml b/components.yaml index ebbcf04816fc..1796c1de157f 100644 --- a/components.yaml +++ b/components.yaml @@ -5,7 +5,7 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.30.0 + tag: v4.30.1 develop: main ESMA_cmake: From 8aa4cca61bb2a19aa72a8219db9a21e4987d399d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 10 Sep 2024 20:26:18 -0400 Subject: [PATCH 67/77] restart_simulator --- CHANGELOG.md | 1 + benchmarks/io/CMakeLists.txt | 1 + .../io/restart_simulator/CMakeLists.txt | 16 + benchmarks/io/restart_simulator/README.md | 19 + .../restart_simulator/restart_simulator.F90 | 716 ++++++++++++++++++ 5 files changed, 753 insertions(+) create mode 100644 benchmarks/io/restart_simulator/CMakeLists.txt create mode 100644 benchmarks/io/restart_simulator/README.md create mode 100644 benchmarks/io/restart_simulator/restart_simulator.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index c48ef20b3d58..54711c4c7c5a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Add restart benchmark code `restart_simulator.x` in bechmark directory - Start implementing changes for vertical regridding in ExtData - Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file - Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x diff --git a/benchmarks/io/CMakeLists.txt b/benchmarks/io/CMakeLists.txt index d82b493693a3..b7d8c9c1874d 100644 --- a/benchmarks/io/CMakeLists.txt +++ b/benchmarks/io/CMakeLists.txt @@ -2,3 +2,4 @@ add_subdirectory(raw_bw) add_subdirectory(gatherv) add_subdirectory(combo) add_subdirectory(checkpoint_simulator) +add_subdirectory(restart_simulator) diff --git a/benchmarks/io/restart_simulator/CMakeLists.txt b/benchmarks/io/restart_simulator/CMakeLists.txt new file mode 100644 index 000000000000..be380f0d165a --- /dev/null +++ b/benchmarks/io/restart_simulator/CMakeLists.txt @@ -0,0 +1,16 @@ +set(exe restart_simulator.x) +set(MODULE_DIRECTORY ${esma_include}/benchmarks/io/restart_simulator) + +ecbuild_add_executable ( + TARGET ${exe} + SOURCES restart_simulator.F90 + DEFINITIONS USE_MPI) + +target_link_libraries (${exe} PRIVATE MAPL.shared MAPL.base MPI::MPI_Fortran FARGPARSE::fargparse ESMF::ESMF ) +target_include_directories (${exe} PUBLIC $) +set_target_properties (${exe} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + +# CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 +if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") + target_link_libraries(${exe} PRIVATE OpenMP::OpenMP_Fortran) +endif () diff --git a/benchmarks/io/restart_simulator/README.md b/benchmarks/io/restart_simulator/README.md new file mode 100644 index 000000000000..3152425b0575 --- /dev/null +++ b/benchmarks/io/restart_simulator/README.md @@ -0,0 +1,19 @@ +This benchmark simulates writing a series of 3D variables of a given cubed-sphere resolution to a file using the same strategies as used by the real checkpoint code in MAPL + +The code has the following options and needs an ESMF rc file named checkpoint\_benchmark.rc + +- "NX:" the x distribution for each face +- "NY:" the y distribution for each face +- "IM\_WORLD:" the cube resolution +- "LM:" the nubmer 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 +- "SCATTER\_3D:" gather all levels at once (default is false which means a level at a time is gathered) +- "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 +- "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 diff --git a/benchmarks/io/restart_simulator/restart_simulator.F90 b/benchmarks/io/restart_simulator/restart_simulator.F90 new file mode 100644 index 000000000000..235cba280b5b --- /dev/null +++ b/benchmarks/io/restart_simulator/restart_simulator.F90 @@ -0,0 +1,716 @@ +#include "MAPL_ErrLog.h" +module mapl_restart_support_mod + + use ESMF + use MPI + use NetCDF + use MAPL_ErrorHandlingMod + use MAPL_MemUtilsMod + use, intrinsic :: iso_fortran_env, only: INT64, REAL64, REAL32 + implicit none + + real(kind=REAL64), parameter :: byte_to_mega = (1.0d0/1024.0d0)*(1.0d0/1024.0d0) + type array_wrapper + character(len=:), allocatable :: field_name + real, allocatable :: field(:,:,:) + end type + + type test_support + integer :: nx,ny,im_world,lm,num_arrays,num_readers,my_rank + integer :: scatter_comm + integer :: readers_comm + integer :: xcomm + integer :: ycomm + integer :: ncid + integer, allocatable :: i1(:),in(:),j1(:),jn(:) + type(array_wrapper), allocatable :: bundle(:) + integer :: face_index + integer(kind=INT64) :: read_counter + logical :: scatter_3d + logical :: split_file + logical :: extra_info + logical :: read_barrier + logical :: do_reads + real(kind=REAL64) :: data_volume + real(kind=REAL64) :: time_reading + real(kind=REAL64) :: time_mpi + logical :: netcdf_reads + integer :: n_trials + logical :: random + + integer(kind=INT64) :: mpi_time + integer(kind=INT64) :: read_3d_time + integer(kind=INT64) :: read_2d_time + integer(kind=INT64) :: open_file_time + integer(kind=INT64) :: close_file_time + contains + procedure :: set_parameters + procedure :: compute_decomposition + procedure :: allocate_n_arrays + procedure :: create_arrays + procedure :: create_communicators + procedure :: open_file + procedure :: close_file + procedure :: read_file + procedure :: read_level + procedure :: read_variable + procedure :: reset + end type + +contains + + subroutine set_parameters(this,config_file) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: config_file + type(ESMF_Config) :: config + + integer :: comm_size, status,error_code + + config = ESMF_ConfigCreate() + this%extra_info = .false. + this%read_barrier = .false. + this%do_reads = .true. + call ESMF_ConfigLoadFile(config,config_file) + call ESMF_ConfigGetAttribute(config,this%nx,label="NX:") + call ESMF_ConfigGetAttribute(config,this%ny,label="NY:") + call ESMF_ConfigGetAttribute(config,this%im_world,label="IM_WORLD:") + call ESMF_ConfigGetAttribute(config,this%lm,label="LM:") + call ESMF_ConfigGetAttribute(config,this%num_readers,label="NUM_READERS") + call ESMF_ConfigGetAttribute(config,this%num_arrays,label="NUM_ARRAYS:") + this%scatter_3d = get_logical_key(config,"SCATTER_3D:",.false.) + this%split_file = get_logical_key(config,"SPLIT_FILE:",.false.) + this%extra_info = get_logical_key(config,"EXTRA_INFO:",.false.) + this%read_barrier = get_logical_key(config,"read_BARRIER:",.false.) + this%do_reads = get_logical_key(config,"DO_READS:",.true.) + this%netcdf_reads = get_logical_key(config,"netcdf_reads:",.true.) + this%n_trials = get_integer_key(config,"NTRIALS:",1) + this%random = get_logical_key(config,"RANDOM_DATA:",.true.) + + this%read_counter = 0 + this%read_3d_time = 0 + this%read_2d_time = 0 + this%open_file_time = 0 + this%close_file_time = 0 + this%data_volume = 0.d0 + this%time_reading = 0.d0 + 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) + logical :: val + type(ESMF_Config), intent(Inout) :: config + character(len=*), intent(in) :: label + logical, intent(in) :: default_val + + logical :: is_present + call ESMF_ConfigFindlabel(config,label,isPresent=is_present) + if (is_present) then + call ESMF_ConfigGetAttribute(config,val,label=label) + else + 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 + character(len=*), intent(in) :: label + integer, intent(in) :: default_val + + logical :: is_present + call ESMF_ConfigFindlabel(config,label,isPresent=is_present) + if (is_present) then + call ESMF_ConfigGetAttribute(config,val,label=label) + else + val = default_val + end if + end function + + end subroutine + + subroutine reset(this) + class(test_support), intent(inout) :: this + this%read_counter = 0 + this%read_3d_time = 0 + this%read_2d_time = 0 + this%open_file_time = 0 + this%close_file_time = 0 + this%data_volume = 0.d0 + this%time_reading = 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 + integer, intent(in) :: axis + + integer :: n_loc, rm, im, n + + if (axis == 1) then + n_loc = this%nx + else if (axis ==2) then + n_loc = this%ny + end if + allocate(decomp(n_loc)) + im = this%im_world/n_loc + rm = this%im_world-n_loc*im + do n = 1,n_loc + decomp(n) = im + if (n.le.rm) decomp(n) = im+1 + enddo + + end function + + 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 + integer, allocatable :: seeds(:) + + call MPI_COMM_RANK(MPI_COMM_WORLD,rank,status) + call random_seed(size=seed_size) + allocate(seeds(seed_size)) + seeds = rank + call random_seed(put=seeds) + do n=1,size(this%bundle) + write(formatted_int,'(i0.3)')n + this%bundle(n)%field_name = "VAR"//formatted_int + allocate(this%bundle(n)%field(im,jm,this%lm)) + if (this%random) then + call random_number(this%bundle(n)%field) + else + this%bundle(n)%field = rank + end if + enddo + end subroutine + + subroutine create_arrays(this) + class(test_support), intent(inout) :: 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_Size(MPI_COMM_WORLD,comm_size,status) + allocate(this%bundle(this%num_arrays)) + ims = this%compute_decomposition(axis=1) + jms = this%compute_decomposition(axis=2) + allocate(this%i1(this%nx)) + allocate(this%in(this%nx)) + allocate(this%j1(this%ny*6)) + allocate(this%jn(this%ny*6)) + rank_counter = 0 + this%i1(1)=1 + this%j1(1)=1 + this%in(1)=ims(1) + this%jn(1)=jms(1) + + do i=2,this%nx + this%i1(i) = this%in(i-1)+1 + this%in(i) = this%in(i-1)+ims(i) + enddo + + do j=2,this%ny + this%j1(j) = this%jn(j-1)+1 + this%jn(j) = this%jn(j-1)+jms(j) + enddo + + do n=2,6 + index_offset = (n-1)*this%ny + offset = (n-1)*this%im_world + do j=1,this%ny + this%j1(j+index_offset)=this%j1(j) + offset + this%jn(j+index_offset)=this%jn(j) + offset + enddo + enddo + + do n=1,6 + do j=1,this%ny + do i=1,this%nx + if (rank == rank_counter) then + call this%allocate_n_arrays(ims(i),jms(j)) + end if + rank_counter = rank_counter + 1 + enddo + enddo + enddo + + end subroutine + + subroutine create_communicators(this) + class(test_support), intent(inout) :: this + + integer :: myid,status,nx0,ny0,color,j,ny_by_readers,local_ny + + local_ny = this%ny*6 + call MPI_Comm_Rank(mpi_comm_world,myid,status) + nx0 = mod(myid,this%nx) + 1 + ny0 = myid/this%nx + 1 + color = nx0 + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%ycomm,status) + color = ny0 + call MPI_Comm_Split(MPI_COMM_WORLD,color,myid,this%xcomm,status) + + + ny_by_readers = local_ny/this%num_readers + if (mod(myid,(this%nx*local_ny)/this%num_readers) == 0) then + color = 0 + else + color = MPI_UNDEFINED + end if + call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,this%readers_comm,status) + + if (this%num_readers == local_ny) then + this%scatter_comm = this%xcomm + else + j = ny0 - mod(ny0-1,ny_by_readers) + call MPI_COMM_SPLIT(MPI_COMM_WORLD,j,myid,this%scatter_comm,status) + end if + + call MPI_BARRIER(mpi_comm_world,status) + + + end subroutine + + subroutine close_file(this) + class(test_support), intent(inout) :: this + + integer :: status + + integer(kind=INT64) :: sub_start,sub_end + + call system_clock(count=sub_start) + + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%netcdf_reads) then + status = nf90_close(this%ncid) + else + close(this%ncid) + end if + end if + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + this%close_file_time = sub_end-sub_start + end subroutine + + subroutine open_file(this) + class(test_support), intent(inout) :: this + + integer :: status, rc + integer :: info + integer :: xdim,ydim,zdim,i,varid,create_mode + character(len=:), allocatable :: fname + character(len=3) :: fc + integer(kind=INT64) :: sub_start,sub_end + integer :: writer_rank + + call system_clock(count=sub_start) + if (this%netcdf_reads) then + + create_mode = NF90_NOWRITE + create_mode = IOR(create_mode,NF90_SHARE) + create_mode = IOR(create_mode,NF90_MPIIO) + call MPI_INFO_CREATE(info,status) + call MPI_INFO_SET(info,"cb_buffer_size","16777216",status) + call MPI_INFO_SET(info,"romio_cb_write","enable",status) + if (this%extra_info) then + call MPI_INFO_SET(info,"IBM_largeblock_io","true",status) + call MPI_INFO_SET(info,"striping_unit","4194304",status) + end if + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%split_file) then + call MPI_COMM_RANK(this%readers_comm,writer_rank,status) + write(fc,'(I0.3)')writer_rank + fname = "checkpoint_"//fc//".nc4" + status = nf90_open(fname,ior(NF90_NETCDF4,NF90_CLOBBER), this%ncid) + else + fname = "checkpoint.nc4" + status = nf90_open(fname,create_mode, this%ncid, comm=this%readers_comm, info=info) + end if + end if + else + if (this%readers_comm /= MPI_COMM_NULL) then + if (this%split_file) then + call MPI_COMM_RANK(this%readers_comm,writer_rank,status) + write(fc,'(I0.3)')writer_rank + fname = "checkpoint_"//fc//".bin" + open(file=fname,newunit=this%ncid,status='old',form='unformatted',access='sequential') + end if + end if + end if + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + this%open_file_time = sub_end-sub_start + end subroutine + + + subroutine read_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) + call system_clock(count=sub_start) + call MPI_BARRIER(MPI_COMM_WORLD,status) + do i=1,this%num_arrays + if (this%scatter_3d) then + call this%read_variable(this%bundle(i)%field_name,this%bundle(i)%field) + else + do l = 1,this%lm + call this%read_level(this%bundle(i)%field_name,this%bundle(i)%field(:,:,l),l) + enddo + end if + enddo + call MPI_BARRIER(MPI_COMM_WORLD,status) + call system_clock(count=sub_end) + call MPI_BARRIER(MPI_COMM_WORLD,status) + this%read_3d_time = sub_end-sub_start + call MPI_BARRIER(MPI_COMM_WORLD,status) + end subroutine + + subroutine read_variable(this,var_name,local_var) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: var_name + real, intent(in) :: local_var(:,:,:) + integer :: status + real, allocatable :: buf(:) + integer :: I,J,N,K,L,myrow,myiorank,ndes_x + integer :: start(3), cnt(3) + integer :: jsize, jprev, num_io_rows + integer, allocatable :: sendcounts(:), displs(:) + integer :: im_world,jm_world,varid + real, allocatable :: var(:,:,:) + integer(kind=INT64) :: start_time,end_time,count_rate,lev,start_mpi,end_mpi + real(kind=REAL64) :: io_time + + call system_clock(count_rate=count_rate) + im_world = this%im_world + jm_world = this%im_world*6 + ndes_x = size(this%in) + + call mpi_comm_rank(this%ycomm,myrow,status) + call mpi_comm_rank(this%scatter_comm,myiorank,status) + call mpi_comm_size(this%scatter_comm,num_io_rows,status) + num_io_rows=num_io_rows/ndes_x + + allocate (sendcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) + + if(myiorank==0) then + do j=1,num_io_rows + jsize = this%jn(myrow+j) - this%j1(myrow+j) + 1 + sendcounts((j-1)*ndes_x+1:(j-1)*ndes_x+ndes_x) = ( this%IN - this%I1 + 1) * jsize * this%lm + enddo + + displs(1) = 0 + do i=2,ndes_x*num_io_rows + displs(i) = displs(i-1) + sendcounts(i-1) + enddo + + jsize = 0 + do j=1,num_io_rows + jsize=jsize + (this%jn(myrow+j) - this%j1(myrow+j) + 1) + enddo + allocate(VAR(IM_WORLD,jsize,this%lm), stat=status) + allocate(buf(IM_WORLD*jsize*this%lm), stat=status) + + start(1) = 1 + if (this%split_file) then + start(2) = 1 + else + start(2) = this%j1(myrow+1) + end if + start(3)= 1 + cnt(1) = IM_WORLD + cnt(2) = jsize + cnt(3) = this%lm + + call system_clock(count=start_time) + if (this%do_reads) then + if (this%netcdf_reads) then + status = nf90_inq_varid(this%ncid,name=var_name ,varid=varid) + status = nf90_get_var(this%ncid,varid,var,start,cnt) + else + write(this%ncid)var + end if + else + var=this%my_rank + end if + call system_clock(count=end_time) + this%read_counter = this%read_counter + 1 + io_time = end_time-start_time + this%data_volume = this%data_volume+byte_to_mega*4.d0*size(var,kind=INT64) + this%time_reading = this%time_reading + real(io_time,kind=REAL64)/real(count_rate,kind=REAL64) + + jprev = 0 + k=1 + do l=1,num_io_rows + jsize = this%jn(myrow+l) - this%j1(myrow+l) + 1 + do n=1,ndes_x + do lev =1,this%lm + do j=1,jsize + do i=this%i1(n),this%in(n) + buf(k) = VAR(i,jprev+j, lev) + k=k+1 + end do + end do + enddo + end do + jprev = jprev + jsize + end do + jsize=jprev + + deallocate(VAR, stat=status) + end if + + if(myiorank/=0) then + allocate(buf(0), stat=status) + endif + + call system_clock(count=start_mpi) + call mpi_scatterv( buf, sendcounts, displs, MPI_REAL, local_var, size(local_var), MPI_REAL, & + 0, this%scatter_comm, status ) + call system_clock(count=end_mpi) + this%time_mpi = this%mpi_time + (end_mpi - start_mpi) + if (this%read_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + + deallocate(buf, stat=status) + deallocate (sendcounts, displs, stat=status) + + end subroutine + + subroutine read_level(this,var_name,local_var,z_index) + class(test_support), intent(inout) :: this + character(len=*), intent(in) :: var_name + real, intent(in) :: local_var(:,:) + integer, intent(in) :: z_index + integer :: status + real, allocatable :: buf(:) + integer :: I,J,N,K,L,myrow,myiorank,ndes_x + integer :: start(3), cnt(3) + integer :: jsize, jprev, num_io_rows + integer, allocatable :: sendcounts(:), displs(:) + integer :: im_world,jm_world,varid + real, allocatable :: var(:,:) + integer(kind=INT64) :: start_time,end_time,count_rate,start_mpi,end_mpi + real(kind=REAL64) :: io_time + + call system_clock(count_rate=count_rate) + im_world = this%im_world + jm_world = this%im_world*6 + ndes_x = size(this%in) + + call mpi_comm_rank(this%ycomm,myrow,status) + call mpi_comm_rank(this%scatter_comm,myiorank,status) + call mpi_comm_size(this%scatter_comm,num_io_rows,status) + num_io_rows=num_io_rows/ndes_x + + allocate (sendcounts(ndes_x*num_io_rows), displs(ndes_x*num_io_rows), stat=status) + + if(myiorank==0) then + do j=1,num_io_rows + jsize = this%jn(myrow+j) - this%j1(myrow+j) + 1 + sendcounts((j-1)*ndes_x+1:(j-1)*ndes_x+ndes_x) = ( this%IN - this%I1 + 1) * jsize + enddo + + displs(1) = 0 + do i=2,ndes_x*num_io_rows + displs(i) = displs(i-1) + sendcounts(i-1) + enddo + + jsize = 0 + do j=1,num_io_rows + jsize=jsize + (this%jn(myrow+j) - this%j1(myrow+j) + 1) + enddo + allocate(VAR(IM_WORLD,jsize), stat=status) + allocate(buf(IM_WORLD*jsize), stat=status) + + start(1) = 1 + if (this%split_file) then + start(2) = 1 + else + start(2) = this%j1(myrow+1) + end if + start(3)=z_index + cnt(1) = IM_WORLD + cnt(2) = jsize + cnt(3) = 1 + + call system_clock(count=start_time) + if (this%do_reads) then + if (this%netcdf_reads) then + status = nf90_inq_varid(this%ncid,name=var_name ,varid=varid) + status = nf90_get_var(this%ncid,varid,var,start,cnt) + else + read(this%ncid)var + end if + else + var=this%my_rank + end if + call system_clock(count=end_time) + this%read_counter = this%read_counter + 1 + io_time = end_time-start_time + this%data_volume = this%data_volume+byte_to_mega*4.d0*size(var,kind=INT64) + this%time_reading = this%time_reading + real(io_time,kind=REAL64)/real(count_rate,kind=REAL64) + + jprev = 0 + k=1 + do l=1,num_io_rows + jsize = this%jn(myrow+l) - this%j1(myrow+l) + 1 + do n=1,ndes_x + do j=1,jsize + do i=this%i1(n),this%in(n) + buf(k) = var(i,jprev+j) + k=k+1 + end do + end do + end do + jprev = jprev + jsize + end do + jsize=jprev + + + deallocate(VAR, stat=status) + end if + + if(myiorank/=0) then + allocate(buf(0), stat=status) + endif + + call system_clock(count=start_mpi) + call mpi_scatterv( buf, sendcounts, displs, MPI_REAL, local_var, size(local_var), MPI_REAL, & + 0, this%scatter_comm, status ) + call system_clock(count=end_mpi) + this%mpi_time = this%mpi_time + (end_mpi - start_mpi) + if (this%read_barrier) call MPI_Barrier(MPI_COMM_WORLD,status) + + deallocate(buf, stat=status) + deallocate (sendcounts, displs, stat=status) + + end subroutine + +end module + +#include "MAPL_ErrLog.h" +program checkpoint_tester + use ESMF + use MPI + use NetCDF + use mapl_restart_support_mod + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + implicit NONE + + integer :: status,rank,reader_size,reader_rank,comm_size,i + type(test_support) :: support + integer(kind=INT64) :: start_read,end_time,count_rate,start_app,end_app + real(kind=REAL64) :: time_sum,read_time,create_time,close_time,read_3d_time,read_2d_time + real(kind=REAL64) :: application_time,data_volume + real(kind=REAL64) :: average_volume,average_time + real(kind=REAL64), allocatable :: total_throughput(:), all_proc_throughput(:) + real(kind=REAL64) :: mean_throughput, mean_fs_throughput + real(kind=REAL64) :: std_throughput, std_fs_throughput + + call system_clock(count=start_app,count_rate=count_rate) + call MPI_Init(status) + call MPI_Barrier(MPI_COMM_WORLD,status) + + call MPI_Comm_Rank(MPI_COMM_WORLD,rank,status) + support%my_rank = rank + call MPI_Comm_Size(MPI_COMM_WORLD,comm_size,status) + call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD) + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%set_parameters("restart_benchmark.rc") + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%create_arrays() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%create_communicators() + call MPI_Barrier(MPI_COMM_WORLD,status) + + allocate(total_throughput(support%n_trials)) + allocate(all_proc_throughput(support%n_trials)) + do i=1,support%n_trials + if (rank == 0) write(*,*)"Trial ",i + call support%reset() + + call system_clock(count=start_read) + call MPI_Barrier(MPI_COMM_WORLD,status) + call support%open_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%read_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call support%close_file() + call MPI_Barrier(MPI_COMM_WORLD,status) + + call system_clock(count=end_time) + read_time = real(end_time-start_read,kind=REAL64)/real(count_rate,kind=REAL64) + create_time = real(support%open_file_time,kind=REAL64)/real(count_rate,kind=REAL64) + read_3d_time = real(support%read_3d_time,kind=REAL64)/real(count_rate,kind=REAL64) + close_time = real(support%close_file_time,kind=REAL64)/real(count_rate,kind=REAL64) + time_sum = create_time + read_3d_time + close_time + application_time = real(end_time - start_app,kind=REAL64)/real(count_rate,kind=REAL64) + + if (support%readers_comm /= MPI_COMM_NULL) then + call MPI_COMM_SIZE(support%readers_comm,reader_size,status) + call MPI_COMM_RANK(support%readers_comm,reader_rank,status) + call MPI_AllReduce(support%data_volume,average_volume,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%readers_comm,status) + average_volume = average_volume/real(reader_size,kind=REAL64) + call MPI_AllReduce(support%time_reading,average_time,1,MPI_DOUBLE_PRECISION,MPI_SUM,support%readers_comm,status) + average_time = average_time/real(reader_size,kind=REAL64) + end if + if (rank == 0) then + total_throughput(i) = byte_to_mega*real(support%num_arrays,kind=REAL64)*real(support%im_world,kind=REAL64) & + *real(support%im_world,kind=REAL64)*6.d0*real(support%lm,kind=REAL64)*4.d0/read_3d_time + all_proc_throughput(i) = real(support%num_readers,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 + data_volume = byte_to_mega*real(support%num_arrays,kind=REAL64)*real(support%im_world,kind=REAL64) & + *real(support%im_world,kind=REAL64)*6.d0*real(support%lm,kind=REAL64)*4.d0 + write(*,*)"***************************************************" + write(*,*)"Summary of run: " + write(*,'(A,G16.8)')"Total data volume in megabytes: ",data_volume + write(*,'(A,I3)')"Num readers: ",support%num_readers + write(*,'(A,I6)')"Total cores: ",comm_size + write(*,'(A,I6,I6)')"Cube size/LM: ",support%im_world,support%lm + write(*,'(A,6(L1))')"Split file, 3D_scatter, extra, netcdf output, write barrier, do writes: ",& + support%split_file, support%scatter_3d, & + support%extra_info, & + support%netcdf_reads,support%read_barrier, support%do_reads + write(*,'(A,I6)')"Number of trial: ",support%n_trials + write(*,'(A,G16.8)')"Application time: ",application_time + end if + + if (rank == 0) then + write(*,'(A)')"Real throughput MB/s, Std Real throughput MB/s, file system MB/S, std file system MB/s" + mean_throughput = sum(total_throughput)/real(support%n_trials,kind=REAL64) + mean_fs_throughput = sum(all_proc_throughput)/real(support%n_trials,kind=REAL64) + std_throughput = 0.d0 + std_fs_throughput = 0.d0 + do i=1,support%n_trials + std_throughput = std_throughput + (total_throughput(i)-mean_throughput)**2 + std_fs_throughput = std_fs_throughput + (all_proc_throughput(i)-mean_fs_throughput)**2 + enddo + std_throughput = sqrt(std_throughput/real(support%n_trials,kind=REAL64)) + 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 a6606b52a6f0c47dd146927a0f7bafefd755129b Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 11 Sep 2024 12:42:20 -0400 Subject: [PATCH 68/77] read explicit "string" attribute --- CHANGELOG.md | 1 + pfio/NetCDF4_FileFormatter.F90 | 10 ++++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f06b339e7036..efde291d1e9b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Added ability to read the attribute with explicit type "string" of a netcdf variable. - Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file - Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x - Added Fortran interface to UDUNITS2 diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 26b894e39b44..7ffc315bbbba 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -600,7 +600,6 @@ subroutine put_var_attributes(this, var, varid, unusable, rc) iter = attributes%begin() do while (iter /= attributes%end()) attr_name => iter%key() - p_attribute => iter%value() shp = p_attribute%get_shape() if (size(shp) == 0) then ! scalar @@ -1079,9 +1078,12 @@ subroutine inq_var_attributes(this, var, varid, unusable, rc) call var%add_attribute(trim(attr_name), str) deallocate(str) case (NF90_STRING) - !W.Y. Note: pfio does not support variable's string attribute - ! It only supports global 1-d string attribute - cycle + !$omp critical + status = pfio_get_att_string(this%ncid, varid, trim(attr_name), str) + !$omp end critical + _VERIFY(status) + call var%add_attribute(trim(attr_name), str) + deallocate(str) case default _RETURN(_FAILURE) end select From 7052154f590a35e666321adf44a197a9acae5125 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 16 Sep 2024 13:38:05 -0400 Subject: [PATCH 69/77] fixs #3025 --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 85 +++++++++++------------ 1 file changed, 42 insertions(+), 43 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 542199a2edc9..45deaca7e9b0 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -390,7 +390,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%derived%import_names%at(i) num_derived=num_derived+1 allocate(derived_item) - !call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,_RC) call config_yaml%fillin_derived(current_base_name,derived_item,time,clock,_RC) call self%derived%item_vec%push_back(derived_item) call ESMF_StateGet(Export,current_base_name,field,_RC) @@ -612,15 +611,15 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") - !bundle_iter = IOBundles%begin() - !do while (bundle_iter /= IOBundles%end()) - !io_bundle => bundle_iter%get() - !bracket_side = io_bundle%bracket_side - !entry_num = io_bundle%entry_index - !item => self%primary%item(entry_num) - !call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) - !call bundle_iter%next() - !enddo + bundle_iter = IOBundles%begin() + do while (bundle_iter /= IOBundles%end()) + io_bundle => bundle_iter%get() + bracket_side = io_bundle%bracket_side + entry_num = io_bundle%entry_index + item => self%primary%item_vec%at(entry_num) + call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,current_time,_RC) + call bundle_iter%next() + enddo call MAPL_ExtDataDestroyCFIO(IOBundles,_RC) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") @@ -873,21 +872,21 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataInterpField - !subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) - !type(MAPL_ExtData_State), intent(inout) :: ExtState - !type(PrimaryExport), intent(inout) :: item - !integer, intent(in ) :: filec - !type(ESMF_Time), intent(in ) :: current_time - !integer, optional, intent(out ) :: rc + subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) + type(MAPL_ExtData_State), intent(inout) :: ExtState + type(PrimaryExport), intent(inout) :: item + integer, intent(in ) :: filec + type(ESMF_Time), intent(in ) :: current_time + integer, optional, intent(out ) :: rc - !integer :: status - !integer :: id_ps - !type(ESMF_Field) :: field, newfield,psF + integer :: status + integer :: id_ps + type(ESMF_Field) :: field, newfield,psF - !if (item%do_VertInterp) then - !if (trim(item%importVDir)/=trim(item%fileVDir)) then - !call MAPL_ExtDataFlipVertical(item,filec,_RC) - !end if + if (item%do_VertInterp) then + if (trim(item%importVDir)/=trim(item%fileVDir)) then + call MAPL_ExtDataFlipVertical(item,filec,_RC) + end if !if (item%vartype == MAPL_fieldItem) then !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) !call MAPL_ExtDataGetBracket(item,filec,Field,_RC) @@ -908,27 +907,27 @@ end subroutine MAPL_ExtDataInterpField !end if - !else if (item%do_Fill) then - !if (item%vartype == MAPL_fieldItem) then - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,_RC) - !call MAPL_ExtDataFillField(item,field,newfield,_RC) - !else if (item%vartype == MAPL_VectorField) then - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) - !call MAPL_ExtDataFillField(item,field,newfield,_RC) - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) - !call MAPL_ExtDataFillField(item,field,newfield,_RC) - !end if - !else - !if (trim(item%importVDir)/=trim(item%fileVDir)) then - !call MAPL_ExtDataFlipVertical(item,filec,_RC) - !end if - !end if + else if (item%do_Fill) then + if (item%vartype == MAPL_fieldItem) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) + else if (item%vartype == MAPL_VectorField) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call MAPL_ExtDataFillField(item,field,newfield,_RC) + end if + else + if (trim(item%importVDir)/=trim(item%fileVDir)) then + call MAPL_ExtDataFlipVertical(item,filec,_RC) + end if + end if - !_RETURN(ESMF_SUCCESS) - !end subroutine MAPL_ExtDataVerticalInterpolate + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_ExtDataVerticalInterpolate function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) From cae216f916c9601b48b0b4e57935025ef3c9ba5e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 16 Sep 2024 16:27:41 -0400 Subject: [PATCH 70/77] too zelous restore --- CHANGELOG.md | 4 +- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 123 ++++++++++++++-------- gridcomps/ExtData2G/ExtDataTypeDef.F90 | 4 + 3 files changed, 83 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c1b3669db898..ccb1d53fbca0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,8 +12,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Added ability to read the attribute with explicit type "string" of a netcdf variable. -- Start implementing changes for vertical regridding in ExtData +- Added ability to read the attribute with explicit type "string" of a netcdf variable. +- Start to implement changes for vertical regridding in ExtData - Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file - Added new driver, CapDriver.x, to excerise the MAPL_Cap with the configuratable component also used by ExtDataDriver.x - Added Fortran interface to UDUNITS2 diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 45deaca7e9b0..2561c0dd855a 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -882,30 +882,33 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) integer :: status integer :: id_ps type(ESMF_Field) :: field, newfield,psF + type(PrimaryExport), pointer :: ps_item if (item%do_VertInterp) then if (trim(item%importVDir)/=trim(item%fileVDir)) then call MAPL_ExtDataFlipVertical(item,filec,_RC) end if - !if (item%vartype == MAPL_fieldItem) then - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,_RC) - !id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - !call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) - !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - - !else if (item%vartype == MAPL_VectorField) then - - !id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) - !call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,_RC) - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) - !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - !call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) - !call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) - !call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) - - !end if + if (item%vartype == MAPL_fieldItem) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,_RC) + id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) + ps_item => ExtState%primary%item_vec%at(id_ps) + call MAPL_ExtDataGetBracket(ps_item,filec,field=psF,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + + else if (item%vartype == MAPL_VectorField) then + + id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) + ps_item => ExtState%primary%item_vec%at(id_ps) + call MAPL_ExtDataGetBracket(ps_item,filec,field=psF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,_RC) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,_RC) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,_RC) + + end if else if (item%do_Fill) then if (item%vartype == MAPL_fieldItem) then @@ -995,7 +998,6 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) end function MAPL_ExtDataGridChangeLev subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) - type(PrimaryExport), intent(inout) :: item integer, intent(in ) :: bside type(ESMF_Field), optional, intent(inout) :: field @@ -1019,17 +1021,37 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then - call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then - call item%modelGridFields%comp2%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary2%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp2%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then - call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then - call item%modelGridFields%comp2%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary2%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp2%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if end if else if (present(bundle)) then @@ -1040,11 +1062,21 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then if (Bside == MAPL_ExtDataLeft) then - call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if else if (Bside == MAPL_ExtDataRight) then - call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) - _RETURN(ESMF_SUCCESS) + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) + _RETURN(ESMF_SUCCESS) + end if end if else if (present(bundle)) then !if (Bside == MAPL_ExtDataLeft) then @@ -1284,20 +1316,19 @@ subroutine createFileLevBracket(item,cf,rc) type (ESMF_Grid) :: grid, newgrid type(ESMF_Field) :: field,new_field - _FAIL('you be bad') - !call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) - !newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,_RC) - !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) - !call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,_RC) - !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) - !call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,_RC) - !if (item%vartype==MAPL_VectorField) then - !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) - !call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,_RC) - !new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) - !call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,_RC) - !end if - !_RETURN(_SUCCESS) + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,_RC) + if (item%vartype==MAPL_VectorField) then + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,_RC) + end if + _RETURN(_SUCCESS) end subroutine createFileLevBracket diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index 295f979b7a9b..e34d9c1a2907 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -20,6 +20,9 @@ module MAPL_ExtDataTypeDef ! fields to store endpoints for interpolation of a vector pair type(ExtDataBracket) :: comp1 type(ExtDataBracket) :: comp2 + ! if vertically interpolating vector fields + type(ExtDataBracket) :: auxiliary1 + type(ExtDataBracket) :: auxiliary2 logical :: initialized = .false. end type BracketingFields @@ -37,6 +40,7 @@ module MAPL_ExtDataTypeDef class(ExtDataAbstractFileHandler), allocatable :: filestream ! if primary export represents a pair of vector fields + logical :: isVector type(BracketingFields) :: modelGridFields ! names of the two vector components in the gridded component where import is declared From cd7bf91e1cdf554f8436a04bf5ba9c1b352c0a50 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 19 Sep 2024 09:27:17 -0400 Subject: [PATCH 71/77] Fixes #3034. Convert Cap time print to colons --- CHANGELOG.md | 2 +- docs/tutorial/mapl_tutorials/hello_world/README.md | 14 +++++++------- gridcomps/Cap/MAPL_CapGridComp.F90 | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ccb1d53fbca0..2b78a951ab37 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,7 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - +- Fixed time print in Cap GC (from slashes to colons) - Added ability to read the attribute with explicit type "string" of a netcdf variable. - Start to implement changes for vertical regridding in ExtData - Add ability to connect export of the MAPL hierachy to ExtData via CAP.rc file diff --git a/docs/tutorial/mapl_tutorials/hello_world/README.md b/docs/tutorial/mapl_tutorials/hello_world/README.md index 59b1075b196d..1596af2c8c26 100644 --- a/docs/tutorial/mapl_tutorials/hello_world/README.md +++ b/docs/tutorial/mapl_tutorials/hello_world/README.md @@ -34,7 +34,7 @@ After this call MAPL_GenericInitialize is called. This is again a MAPL call that Finally we get to the run method my_run. Notice it has the same interface the initialize method. This was registered and will be executed each time step. As you can see if does very little in this example. It gets the current time from the ESMF clock (this literally a clock that is advanced by the MAPL "CAP"). The time is stored in a variable of `type(ESMF_Time)` declared in the subroutine. It then prints the obligatory "Hello World" and finally uses an ESMF cal which takes an ESMF time and prints it as a string. # A Note on Error Handling -You will notice that the setServices, initialize, and run subroutines all have an optional rc return variable. This is represents a return code that the calling routine can check to see if the subroutine executed successfully or produced an error. All ESMF and MAPL subroutines and functions have an optional rc value that can be checked when making a call. To check the return status you would do something like this. +You will notice that the setServices, initialize, and run subroutines all have an optional rc return variable. This is represents a return code that the calling routine can check to see if the subroutine executed successfully or produced an error. All ESMF and MAPL subroutines and functions have an optional rc value that can be checked when making a call. To check the return status you would do something like this. ``` integer :: status @@ -51,7 +51,7 @@ end This would get very tedious, not to mention make the code hard to read if the user had to do this after every subroutine or function call. To assist the developer MAPL defines a collection of preprocessor macros for error checking . -You will notice that all subroutine calls in this example end with `_RC`. This is a preprocessor macro that expands to `rc=status); _VERIFY(status`. +You will notice that all subroutine calls in this example end with `_RC`. This is a preprocessor macro that expands to `rc=status); _VERIFY(status`. `_VERIFY` itself is another macro that essentially implements the lines after the call to `ESMF_Foo` in the previous example. It will check the status and if there is an error report the file and line and return. @@ -74,7 +74,7 @@ srun: cluster configuration lacks support for cpu binding Integer*4 Resource Parameter: HEARTBEAT_DT:3600 NOT using buffer I/O for file: cap_restart CAP: Read CAP restart properly, Current Date = 2007/08/01 - CAP: Current Time = 00/00/00 + CAP: Current Time = 00:00:00 Character Resource Parameter: ROOT_CF:hello_world.rc Character Resource Parameter: ROOT_NAME:hello_world Character Resource Parameter: HIST_CF:HISTORY.rc @@ -107,14 +107,14 @@ end Time ------------------------------- AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used ``` - Lets see how this corresponds to what is in the input files. + Lets see how this corresponds to what is in the input files. First lets discuss the CAP.rc, the relevant lines are ``` JOB_SGMT: 00000001 000000 HEARTBEAT_DT: 3600 ``` -which tell the MAPL "CAP" to run 1 day via the JOB_SGMT line and with a timestep of 3600s. In addition the +which tell the MAPL "CAP" to run 1 day via the JOB_SGMT line and with a timestep of 3600s. In addition the ``` ROOT_CF: hello_world.rc ``` @@ -134,7 +134,7 @@ SHMEM: Total PEs = 1 ``` which says we are using 1 MPI task. Then later you the tell works and quick glance should confirm it is stepping the clock by 1 hour each time. Finally you see lines like this: -``` -AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used +``` +AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used ``` This is actually reported by the "CAP" itself. and prints the current time as well as some statistics about memroy use and throughput. The astute user will notice that the time reported here is 1 hour after the time printed in the gridded component. This is because the clock is advanced at the end of each iteration in the "CAP", after the component is run and this reporting is at the very end of each iteration. diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 5f09f36ca6fc..2ee0e4dca2fd 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -1678,7 +1678,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) call MAPL_GetLogger(MAPLOBJ, lgr, _RC) call lgr%info('Read CAP restart properly, Current Date = %i4.4~/%i2.2~/%i2.2', CUR_YY, CUR_MM, CUR_DD) - call lgr%info(' Current Time = %i2.2~/%i2.2~/%i2.2', CUR_H, CUR_M, CUR_S) + call lgr%info(' Current Time = %i2.2~:%i2.2~:%i2.2', CUR_H, CUR_M, CUR_S) 999 continue ! Initialize Current time From fb9136d0366d6939f92778129ccdfe516b675d7d Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 19 Sep 2024 13:51:43 -0400 Subject: [PATCH 72/77] querring VLOCATION on MAPL_VerticalMethods.F90 for rank 2 fields --- CHANGELOG.md | 2 ++ base/MAPL_VerticalMethods.F90 | 8 ++++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b78a951ab37..50106201d1ed 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 +- Made the POSITIVE field attribute defaults to "down" in case it is not found +- VLOCATION is not querried in MAPL_VerticalMethods.F90 for rank 2 fields - Fixed time print in Cap GC (from slashes to colons) - Added ability to read the attribute with explicit type "string" of a netcdf variable. - Start to implement changes for vertical regridding in ExtData diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 205e3c6416f3..2627297bdd1a 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -490,17 +490,21 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) do i=1,numVars call ESMF_FieldBundleGet(bundle,i,field,_RC) - call ESMF_AttributeGet(field,name="POSITIVE", value=positive, _RC) + positive = 'down' + call ESMF_AttributeGet(field,NAME="POSITIVE",isPresent=isPresent,_RC) + if (isPresent) then + call ESMF_AttributeGet(field,name="POSITIVE", value=positive, _RC) + end if if (i .eq. 1) this%positive=positive if (i .gt. 1) then _ASSERT(this%positive==positive,"Fields have mistmatched positive attributes") this%positive=positive end if call ESMF_FieldGet(field,dimCount=FieldRank,_RC) - call ESMF_AttributeGet(field,name="VLOCATION", value=location(i),_RC) if (fieldRank==2) then varDims(i)=0 else if (fieldRank==3) then + call ESMF_AttributeGet(field,name="VLOCATION", value=location(i),_RC) call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC) varDims(i)=size(ptr3d,3) if (location(i) == MAPL_VLocationNone) then From 6f596a5b9d06939792e38833553855bf69715288 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 20 Sep 2024 13:18:55 -0400 Subject: [PATCH 73/77] Add extdata tests to test compression, bit-shaving, and quantization --- CHANGELOG.md | 2 ++ .../ExtData_Testing_Framework/CMakeLists.txt | 12 ++++++++ .../test_cases/case30/AGCM1.rc | 24 +++++++++++++++ .../test_cases/case30/AGCM2.rc | 29 +++++++++++++++++++ .../test_cases/case30/CAP.rc | 4 +++ .../test_cases/case30/CAP1.rc | 25 ++++++++++++++++ .../test_cases/case30/CAP2.rc | 15 ++++++++++ .../test_cases/case30/ExtData.rc | 13 +++++++++ .../test_cases/case30/HISTORY1.rc | 14 +++++++++ .../test_cases/case30/HISTORY2.rc | 5 ++++ .../test_cases/case30/README | 1 + .../test_cases/case30/extdata.yaml | 5 ++++ .../test_cases/case31/AGCM1.rc | 24 +++++++++++++++ .../test_cases/case31/AGCM2.rc | 29 +++++++++++++++++++ .../test_cases/case31/CAP.rc | 4 +++ .../test_cases/case31/CAP1.rc | 25 ++++++++++++++++ .../test_cases/case31/CAP2.rc | 15 ++++++++++ .../test_cases/case31/ExtData.rc | 13 +++++++++ .../test_cases/case31/HISTORY1.rc | 15 ++++++++++ .../test_cases/case31/HISTORY2.rc | 5 ++++ .../test_cases/case31/README | 1 + .../test_cases/case31/extdata.yaml | 5 ++++ .../test_cases/case32/AGCM1.rc | 24 +++++++++++++++ .../test_cases/case32/AGCM2.rc | 29 +++++++++++++++++++ .../test_cases/case32/CAP.rc | 4 +++ .../test_cases/case32/CAP1.rc | 25 ++++++++++++++++ .../test_cases/case32/CAP2.rc | 15 ++++++++++ .../test_cases/case32/ExtData.rc | 13 +++++++++ .../test_cases/case32/HISTORY1.rc | 16 ++++++++++ .../test_cases/case32/HISTORY2.rc | 5 ++++ .../test_cases/case32/README | 1 + .../test_cases/case32/extdata.yaml | 5 ++++ .../test_cases/case33/AGCM1.rc | 24 +++++++++++++++ .../test_cases/case33/AGCM2.rc | 29 +++++++++++++++++++ .../test_cases/case33/CAP.rc | 4 +++ .../test_cases/case33/CAP1.rc | 25 ++++++++++++++++ .../test_cases/case33/CAP2.rc | 15 ++++++++++ .../test_cases/case33/ExtData.rc | 13 +++++++++ .../test_cases/case33/HISTORY1.rc | 16 ++++++++++ .../test_cases/case33/HISTORY2.rc | 5 ++++ .../test_cases/case33/README | 1 + .../test_cases/case33/extdata.yaml | 5 ++++ .../test_cases/case34/AGCM1.rc | 24 +++++++++++++++ .../test_cases/case34/AGCM2.rc | 29 +++++++++++++++++++ .../test_cases/case34/CAP.rc | 4 +++ .../test_cases/case34/CAP1.rc | 25 ++++++++++++++++ .../test_cases/case34/CAP2.rc | 15 ++++++++++ .../test_cases/case34/ExtData.rc | 13 +++++++++ .../test_cases/case34/HISTORY1.rc | 16 ++++++++++ .../test_cases/case34/HISTORY2.rc | 5 ++++ .../test_cases/case34/README | 1 + .../test_cases/case34/extdata.yaml | 5 ++++ .../test_cases/extdata_2g_cases.txt | 5 ++++ .../test_cases/test_case_descriptions.md | 5 ++++ 54 files changed, 706 insertions(+) create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/README create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/README create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/README create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/README create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/README create mode 100644 Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml diff --git a/CHANGELOG.md b/CHANGELOG.md index 50106201d1ed..ef064bd77d0b 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 +- Added 5 new ExtData tests to test compression, bit-shaving, and quantization + ### Changed - Made the POSITIVE field attribute defaults to "down" in case it is not found diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index 283e53bea457..8c54d6ef0f0d 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -22,6 +22,13 @@ set(SLOW_TESTS "case23" ) +# We have 3 tests that require netcdf Quantize support +set(QUANTIZE_TESTS + "case32" + "case33" + "case34" +) + 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) @@ -52,6 +59,11 @@ file(STRINGS "test_cases/extdata_2g_cases.txt" TEST_CASES_2G) foreach(TEST_CASE ${TEST_CASES_2G}) + # Skip tests that require Quantize support if we don't have it + if (NOT NETCDF_HAS_QUANTIZE AND ${TEST_CASE} IN_LIST QUANTIZE_TESTS) + continue() + endif() + 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) else() diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc new file mode 100644 index 000000000000..250d183190d6 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY1.rc @@ -0,0 +1,14 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/README b/Tests/ExtData_Testing_Framework/test_cases/case30/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case30/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc new file mode 100644 index 000000000000..4f4a121f057b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY1.rc @@ -0,0 +1,15 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.nbits: 10, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/README b/Tests/ExtData_Testing_Framework/test_cases/case31/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case31/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc new file mode 100644 index 000000000000..5dd8d0325c23 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'bitgroom', + case1.quantization_level: 5, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/README b/Tests/ExtData_Testing_Framework/test_cases/case32/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case32/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc new file mode 100644 index 000000000000..91edade2a3d6 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'bitround', + case1.quantization_level: 10, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/README b/Tests/ExtData_Testing_Framework/test_cases/case33/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case33/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc new file mode 100644 index 000000000000..8d0e541a189a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY1.rc @@ -0,0 +1,16 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000, + case1.deflate: 1, + case1.quantization_algorithm: 'granular_bitround', + case1.quantization_level: 5, + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/README b/Tests/ExtData_Testing_Framework/test_cases/case34/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framework/test_cases/case34/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt index dd87b48b792c..88fb9e573161 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt +++ b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt @@ -27,3 +27,8 @@ case26 case27 case28 case29 +case30 +case31 +case32 +case33 +case34 diff --git a/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md b/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md index 686e2fc7fc55..f3700c12e5ee 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md +++ b/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md @@ -34,3 +34,8 @@ path_to_script/run_extdatadriver_cases.py --builddir path_to_geos_install/bin -- 27. Case with a "gap" in the data 28. "Replay" type run, update every time 29. "Replay" type run, update once a day with offset +30. Case1 with deflate compression +31. Case1 with deflate compression and MAPL bit-shaving +32. Case1 with deflate compression and NetCDF bitgroom quantization (only enabled if netcdf built with quantization support) +33. Case1 with deflate compression and NetCDF bitround quantization (only enabled if netcdf built with quantization support) +34. Case1 with deflate compression and NetCDF granular_bitround quantization (only enabled if netcdf built with quantization support) From f1bf0c236d2fba0d6e8c56229a391e78ea10bced Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 23 Sep 2024 12:27:17 -0400 Subject: [PATCH 74/77] Change all tests to have 2-digits --- Tests/ExtData_Testing_Framework/CMakeLists.txt | 2 +- .../test_cases/{case1 => case01}/AGCM1.rc | 0 .../test_cases/{case1 => case01}/AGCM2.rc | 0 .../test_cases/{case1 => case01}/CAP.rc | 0 .../test_cases/{case1 => case01}/CAP1.rc | 0 .../test_cases/{case1 => case01}/CAP2.rc | 0 .../test_cases/{case1 => case01}/ExtData.rc | 0 .../test_cases/{case1 => case01}/HISTORY1.rc | 0 .../test_cases/{case1 => case01}/HISTORY2.rc | 0 .../test_cases/{case1 => case01}/README | 0 .../test_cases/{case1 => case01}/extdata.yaml | 0 .../test_cases/{case2 => case02}/AGCM1.rc | 0 .../test_cases/{case2 => case02}/AGCM2.rc | 0 .../test_cases/{case2 => case02}/CAP.rc | 0 .../test_cases/{case2 => case02}/CAP1.rc | 0 .../test_cases/{case2 => case02}/CAP2.rc | 0 .../test_cases/{case2 => case02}/ExtData.rc | 0 .../test_cases/{case2 => case02}/HISTORY1.rc | 0 .../test_cases/{case2 => case02}/HISTORY2.rc | 0 .../test_cases/{case2 => case02}/README | 0 .../test_cases/{case2 => case02}/extdata.yaml | 0 .../test_cases/{case3 => case03}/AGCM1.rc | 0 .../test_cases/{case3 => case03}/AGCM2.rc | 0 .../test_cases/{case3 => case03}/CAP.rc | 0 .../test_cases/{case3 => case03}/CAP1.rc | 0 .../test_cases/{case3 => case03}/CAP2.rc | 0 .../test_cases/{case3 => case03}/ExtData.rc | 0 .../test_cases/{case3 => case03}/HISTORY1.rc | 0 .../test_cases/{case3 => case03}/HISTORY2.rc | 0 .../test_cases/{case3 => case03}/README | 0 .../test_cases/{case3 => case03}/extdata.yaml | 0 .../test_cases/{case4 => case04}/AGCM1.rc | 0 .../test_cases/{case4 => case04}/AGCM2.rc | 0 .../test_cases/{case4 => case04}/CAP.rc | 0 .../test_cases/{case4 => case04}/CAP1.rc | 0 .../test_cases/{case4 => case04}/CAP2.rc | 0 .../test_cases/{case4 => case04}/ExtData.rc | 0 .../test_cases/{case4 => case04}/HISTORY1.rc | 0 .../test_cases/{case4 => case04}/HISTORY2.rc | 0 .../test_cases/{case4 => case04}/README | 0 .../test_cases/{case4 => case04}/extdata.yaml | 0 .../test_cases/{case5 => case05}/AGCM1.rc | 0 .../test_cases/{case5 => case05}/AGCM2.rc | 0 .../test_cases/{case5 => case05}/CAP.rc | 0 .../test_cases/{case5 => case05}/CAP1.rc | 0 .../test_cases/{case5 => case05}/CAP2.rc | 0 .../test_cases/{case5 => case05}/ExtData.rc | 0 .../test_cases/{case5 => case05}/HISTORY1.rc | 0 .../test_cases/{case5 => case05}/HISTORY2.rc | 0 .../test_cases/{case5 => case05}/README | 0 .../test_cases/{case5 => case05}/extdata.yaml | 0 .../test_cases/{case6 => case06}/AGCM1.rc | 0 .../test_cases/{case6 => case06}/AGCM2.rc | 0 .../test_cases/{case6 => case06}/CAP.rc | 0 .../test_cases/{case6 => case06}/CAP1.rc | 0 .../test_cases/{case6 => case06}/CAP2.rc | 0 .../test_cases/{case6 => case06}/ExtData.rc | 0 .../test_cases/{case6 => case06}/HISTORY1.rc | 0 .../test_cases/{case6 => case06}/HISTORY2.rc | 0 .../test_cases/{case6 => case06}/README | 0 .../test_cases/{case6 => case06}/extdata.yaml | 0 .../test_cases/{case7 => case07}/AGCM1.rc | 0 .../test_cases/{case7 => case07}/AGCM2.rc | 0 .../test_cases/{case7 => case07}/CAP.rc | 0 .../test_cases/{case7 => case07}/CAP1.rc | 0 .../test_cases/{case7 => case07}/CAP2.rc | 0 .../test_cases/{case7 => case07}/ExtData.rc | 0 .../test_cases/{case7 => case07}/HISTORY1.rc | 0 .../test_cases/{case7 => case07}/HISTORY2.rc | 0 .../test_cases/{case7 => case07}/README | 0 .../test_cases/{case7 => case07}/extdata.yaml | 0 .../test_cases/{case8 => case08}/AGCM1.rc | 0 .../test_cases/{case8 => case08}/AGCM2.rc | 0 .../test_cases/{case8 => case08}/CAP.rc | 0 .../test_cases/{case8 => case08}/CAP1.rc | 0 .../test_cases/{case8 => case08}/CAP2.rc | 0 .../test_cases/{case8 => case08}/ExtData.rc | 0 .../test_cases/{case8 => case08}/HISTORY1.rc | 0 .../test_cases/{case8 => case08}/HISTORY2.rc | 0 .../test_cases/{case8 => case08}/README | 0 .../test_cases/{case8 => case08}/extdata.yaml | 0 .../test_cases/{case9 => case09}/AGCM1.rc | 0 .../test_cases/{case9 => case09}/AGCM2.rc | 0 .../test_cases/{case9 => case09}/CAP.rc | 0 .../test_cases/{case9 => case09}/CAP1.rc | 0 .../test_cases/{case9 => case09}/CAP2.rc | 0 .../test_cases/{case9 => case09}/ExtData.rc | 0 .../test_cases/{case9 => case09}/HISTORY1.rc | 0 .../test_cases/{case9 => case09}/HISTORY2.rc | 0 .../test_cases/{case9 => case09}/README | 0 .../test_cases/{case9 => case09}/extdata.yaml | 0 .../test_cases/extdata_1g_cases.txt | 16 ++++++++-------- .../test_cases/extdata_2g_cases.txt | 18 +++++++++--------- 93 files changed, 18 insertions(+), 18 deletions(-) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case1 => case01}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case2 => case02}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case3 => case03}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case4 => case04}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case5 => case05}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case6 => case06}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case7 => case07}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case8 => case08}/extdata.yaml (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/AGCM1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/AGCM2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/CAP.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/CAP1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/CAP2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/ExtData.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/HISTORY1.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/HISTORY2.rc (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/README (100%) rename Tests/ExtData_Testing_Framework/test_cases/{case9 => case09}/extdata.yaml (100%) diff --git a/Tests/ExtData_Testing_Framework/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt index 8c54d6ef0f0d..afcb2b5be93f 100644 --- a/Tests/ExtData_Testing_Framework/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framework/CMakeLists.txt @@ -13,7 +13,7 @@ set(cutoff "7") # be skipped for ESSENTIAL testing. Most ExtData tests # take 1-2 seconds at most, but some take 20-30 seconds. set(SLOW_TESTS - "case6" + "case06" "case14" "case15" "case16" diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case01/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/README b/Tests/ExtData_Testing_Framework/test_cases/case01/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/README rename to Tests/ExtData_Testing_Framework/test_cases/case01/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case01/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case01/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case02/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/README b/Tests/ExtData_Testing_Framework/test_cases/case02/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/README rename to Tests/ExtData_Testing_Framework/test_cases/case02/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case02/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case02/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case03/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/README b/Tests/ExtData_Testing_Framework/test_cases/case03/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/README rename to Tests/ExtData_Testing_Framework/test_cases/case03/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case03/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case03/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case04/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/README b/Tests/ExtData_Testing_Framework/test_cases/case04/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/README rename to Tests/ExtData_Testing_Framework/test_cases/case04/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case04/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case04/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case05/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/README b/Tests/ExtData_Testing_Framework/test_cases/case05/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/README rename to Tests/ExtData_Testing_Framework/test_cases/case05/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case05/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case05/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case06/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/README b/Tests/ExtData_Testing_Framework/test_cases/case06/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/README rename to Tests/ExtData_Testing_Framework/test_cases/case06/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case06/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case06/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case07/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/README b/Tests/ExtData_Testing_Framework/test_cases/case07/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/README rename to Tests/ExtData_Testing_Framework/test_cases/case07/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case07/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case07/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case08/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/README b/Tests/ExtData_Testing_Framework/test_cases/case08/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/README rename to Tests/ExtData_Testing_Framework/test_cases/case08/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case08/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case08/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/CAP2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/ExtData.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case09/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/README b/Tests/ExtData_Testing_Framework/test_cases/case09/README similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/README rename to Tests/ExtData_Testing_Framework/test_cases/case09/README diff --git a/Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case09/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case09/extdata.yaml diff --git a/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt b/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt index 86154c511a74..8807d45e921f 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt +++ b/Tests/ExtData_Testing_Framework/test_cases/extdata_1g_cases.txt @@ -1,11 +1,11 @@ -case1 -case3 -case4 -case5 -case6 -case7 -case8 -case9 +case01 +case03 +case04 +case05 +case06 +case07 +case08 +case09 case10 case11 case12 diff --git a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt index 88fb9e573161..76be9d4d54f8 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt +++ b/Tests/ExtData_Testing_Framework/test_cases/extdata_2g_cases.txt @@ -1,12 +1,12 @@ -case1 -case2 -case3 -case4 -case5 -case6 -case7 -case8 -case9 +case01 +case02 +case03 +case04 +case05 +case06 +case07 +case08 +case09 case10 case11 case12 From d764fa4421cf483e905867488d13c2cf99eab899 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 23 Sep 2024 12:28:32 -0400 Subject: [PATCH 75/77] Update changelog --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e19a3de7e6b9..2ed671ca2e7a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Add restart benchmark code `restart_simulator.x` in bechmark directory +- Rename all single-digit ExtData tests to have a leading zero (i.e., `case1` -> `case01`) +- Add restart benchmark code `restart_simulator.x` in benchmark directory - Start implementing changes for vertical regridding in ExtData - Made the POSITIVE field attribute defaults to "down" in case it is not found - VLOCATION is not querried in MAPL_VerticalMethods.F90 for rank 2 fields From f1b5a83dbbc60613a3be0bde0504e0a018c0940a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 23 Sep 2024 15:14:58 -0400 Subject: [PATCH 76/77] Prepare for 2.48.0 Release --- CHANGELOG.md | 14 ++++++++++++-- CMakeLists.txt | 2 +- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2ed671ca2e7a..a672bf9a7893 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +### Changed + +### Fixed + +### Removed + +### Deprecated + +## [2.48.0] - 2024-09-23 + +### Added + - Added 5 new ExtData tests to test compression, bit-shaving, and quantization ### Changed @@ -61,8 +73,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fix profiler PercentageColumn test for GCC 14 - Fix bug in ExtData Tests. CMake was overwriting the `EXTDATA2G_SMALL_TESTS` LABEL with `ESSENTIAL` -### Removed - ### Deprecated - Deprecate `GranularBR` as a quantization method keyword in History. We will prefer `granular_bitround` in the future to match diff --git a/CMakeLists.txt b/CMakeLists.txt index e5dbebcb74e1..212ffb6e0d23 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.47.2 + VERSION 2.48.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 60fb32e4eec7abf1369854c237e2943b0de6857f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 24 Sep 2024 09:12:22 -0400 Subject: [PATCH 77/77] Update changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a672bf9a7893..1c5c4fdae965 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated -## [2.48.0] - 2024-09-23 +## [2.48.0] - 2024-09-24 ### Added