From b01ce3c867af0aad5bb928089fcf95bdb380a7e7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 2 May 2022 10:56:19 -0400 Subject: [PATCH 1/2] Convert many _ASSERT(.false.) to _FAIL() --- CHANGELOG.md | 2 + Tests/ExtDataDriverGridComp.F90 | 4 +- Tests/ExtDataRoot_GridComp.F90 | 2 +- base/Base/Base_Base_implementation.F90 | 30 +- base/BinIO.F90 | 4 +- base/ESMFL_Mod.F90 | 4 +- base/FileIOShared.F90 | 6 +- base/FileMetadataUtilities.F90 | 22 +- base/MAPL_AbstractRegridder.F90 | 56 ++-- base/MAPL_CFIO.F90 | 20 +- base/MAPL_Comms.F90 | 2 +- base/MAPL_CubedSphereGridFactory.F90 | 8 +- base/MAPL_LocStreamMod.F90 | 8 +- base/MAPL_TimeMethods.F90 | 6 +- base/MAPL_VerticalMethods.F90 | 2 +- base/MAPL_sun_uc.F90 | 46 +-- base/NCIO.F90 | 58 ++-- base/StringTemplate.F90 | 4 +- base/read_parallel.H | 2 +- base/sun.H | 4 +- base/tests/mapl_bundleio_test.F90 | 2 +- base/write_parallel.H | 2 +- generic/GenericCplComp.F90 | 8 +- generic/MAPL_Generic.F90 | 22 +- gridcomps/ExtData/ExtDataGridCompMod.F90 | 316 +++++++++--------- gridcomps/History/MAPL_HistoryGridComp.F90 | 12 +- .../History/MAPL_HistoryTrajectoryMod.F90 | 2 +- griddedio/GriddedIO.F90 | 8 +- griddedio/Regrid_Util.F90 | 2 +- include/MAPL_ErrLog.h | 2 +- pfio/AbstractDataReference.F90 | 16 +- pfio/AbstractServer.F90 | 6 +- pfio/ArrayReference.F90 | 14 +- pfio/BaseServer.F90 | 4 +- pfio/ClientThread.F90 | 6 +- pfio/CoordinateVariable.F90 | 12 +- pfio/FileMetadata.F90 | 2 +- pfio/LocalMemReference.F90 | 12 +- pfio/MessageVisitor.F90 | 32 +- pfio/MultiCommServer.F90 | 4 +- pfio/MultiGroupServer.F90 | 6 +- pfio/MultiLayerServer.F90 | 2 +- pfio/NetCDF4_FileFormatter.F90 | 2 +- pfio/ServerThread.F90 | 32 +- pfio/SimpleSocket.F90 | 2 +- pfio/UnlimitedEntity.F90 | 18 +- pfio/pFIO_Utilities.F90 | 2 +- pfio/pfio_writer.F90 | 4 +- shared/MAPL_HeapMod.F90 | 8 +- shared/Shmem/Shmem_implementation.F90 | 2 +- 50 files changed, 427 insertions(+), 425 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9f61fd092319..d626aab3478b 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 ### Changed +- Change many instances of `_ASSERT(.false.,"msg")` to `_FAIL("msg")` + ### Removed ### Deprecated diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index fa52b57b8d52..bb2c3be3be05 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -414,7 +414,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call cap%parseTimes(rc=status) _VERIFY(status) if (allocated(cap%times) .and. cap%run_fbf ) then - _ASSERT(.false.,"can not run forwards and backwards with specific times") + _FAIL("can not run forwards and backwards with specific times") end if _RETURN(ESMF_SUCCESS) @@ -743,7 +743,7 @@ subroutine MAPL_ClockInit ( cf, Clock, nsteps, rc) call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, RC=STATUS) _VERIFY(STATUS) else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif call ESMF_ConfigGetAttribute(cf, datetime, label='BEG_DATE:',rc=status) diff --git a/Tests/ExtDataRoot_GridComp.F90 b/Tests/ExtDataRoot_GridComp.F90 index 9f17a4c920da..194e43f7e491 100644 --- a/Tests/ExtDataRoot_GridComp.F90 +++ b/Tests/ExtDataRoot_GridComp.F90 @@ -677,7 +677,7 @@ subroutine CompareState(State1,State2,tol,rc) enddo end if if (foundDiff(ii)) then - _ASSERT(.false.,'found difference when compare state') + _FAIL('found difference when compare state') end if enddo diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index e886bf5dae45..6664fed2d6f7 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -183,7 +183,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & gridToFieldMap=gridToFieldMap, & rc = status) case default - _ASSERT(.false., 'unsupported rank > 1') + _FAIL( 'unsupported rank > 1') end select else @@ -197,7 +197,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & gridToFieldMap=gridToFieldMap, & rc = status) case default - _ASSERT(.false., 'unsupported rank > 1') + _FAIL( 'unsupported rank > 1') end select endif @@ -290,7 +290,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & totalUWidth=haloWidth(1:griddedDims), & rc = status) case default - _ASSERT(.false., 'only up to 4D are supported') + _FAIL( 'only up to 4D are supported') end select RankCase2d else select case (rank) @@ -325,7 +325,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & totalUWidth=haloWidth(1:griddedDims), & rc = status) case default - _ASSERT(.false., 'only up to 4D are supported') + _FAIL( 'only up to 4D are supported') end select end if _VERIFY(STATUS) @@ -444,7 +444,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & rc = status) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select else @@ -474,7 +474,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & rc = status) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select endif @@ -1385,7 +1385,7 @@ module function MAPL_FieldCreateRename(FIELD, NAME, DoCopy, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only upto 4D are supported') + _FAIL( 'only upto 4D are supported') end select else if (tk == ESMF_TypeKind_R8) then select case (fieldRank) @@ -1422,10 +1422,10 @@ module function MAPL_FieldCreateRename(FIELD, NAME, DoCopy, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select else - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') endif deallocate(gridToFieldMap) @@ -1560,7 +1560,7 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) DIMS = MAPL_DimsHorzVert end if else - _ASSERT(.false., 'rank > 4 not supported') + _FAIL( 'rank > 4 not supported') end if deallocate(gridToFieldMap) @@ -1660,7 +1660,7 @@ module function MAPL_FieldCreateR4(FIELD, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select deallocate(gridToFieldMap) @@ -1762,7 +1762,7 @@ module subroutine MAPL_FieldCopy(from, to, RC) _VERIFY(STATUS) var_3d = vr8_3d case default - _ASSERT(.false., 'unsupported fieldRank (> 3)') + _FAIL( 'unsupported fieldRank (> 3)') end select _RETURN(ESMF_SUCCESS) @@ -2701,7 +2701,7 @@ module subroutine MAPL_FieldDestroy(Field,RC) deallocate(VR8_3d,stat=status) _VERIFY(STATUS) else - _ASSERT(.false., 'unsupported typekind+rank') + _FAIL( 'unsupported typekind+rank') end if call ESMF_FieldDestroy(Field,rc=status) _VERIFY(STATUS) @@ -3088,7 +3088,7 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lats, rc=status) _VERIFY(STATUS) else - _ASSERT(.false.,'if not isCubed, localSearch must be .true.') + _FAIL('if not isCubed, localSearch must be .true.') end if allocate(lons_1d(im),stat=status) _VERIFY(STATUS) @@ -3645,7 +3645,7 @@ module subroutine MAPL_FieldSplit(field, fields, aliasName, rc) end do end if else if (tk == ESMF_TYPEKIND_R8) then - _ASSERT(.false., "R8 overload not implemented yet") + _FAIL( "R8 overload not implemented yet") end if deallocate(gridToFieldMap) diff --git a/base/BinIO.F90 b/base/BinIO.F90 index 2f2dd9735abb..5b3aaf769914 100644 --- a/base/BinIO.F90 +++ b/base/BinIO.F90 @@ -453,7 +453,7 @@ subroutine MAPL_StateVarRead(UNIT, STATE, NAME, arrdes, bootstrapable, RC) _VERIFY(STATUS) !ALT else -!ALT _ASSERT(.false.,'failed mapl_statevarread') +!ALT _FAIL('failed mapl_statevarread') end if @@ -739,7 +739,7 @@ subroutine MAPL_FieldRead(UNIT,FIELD, ARRDES, HomePE, ignoreEOF, RC) call MAPL_VarRead(unit, grid, vr8_4d, rc=status) end if else - _ASSERT(.false., "ERROR: unsupported RANK") + _FAIL( "ERROR: unsupported RANK") endif _VERIFY(STATUS) diff --git a/base/ESMFL_Mod.F90 b/base/ESMFL_Mod.F90 index e3b7de1e38bd..4d0ef998ccec 100644 --- a/base/ESMFL_Mod.F90 +++ b/base/ESMFL_Mod.F90 @@ -3735,7 +3735,7 @@ subroutine Bundle2State (BUN, STA, rc) _VERIFY(STATUS) dst_pr83d = src_pr83d case default - _ASSERT(.false., 'unsupported rank (>= 4)') + _FAIL( 'unsupported rank (>= 4)') end select end if end if @@ -3936,7 +3936,7 @@ SUBROUTINE ESMFL_HALO_R4_2D(GRID, INPUT, RC) if (.not.found) then print *, "Error: need bigger MAX_HALOTYPES value" - _ASSERT(.false., 'no unused slot for halo types') + _FAIL( 'no unused slot for halo types') end if call ESMF_GridGet(GRID, distGrid=distGrid, dimCount=dimCount, RC=STATUS) diff --git a/base/FileIOShared.F90 b/base/FileIOShared.F90 index 4a7adcad26e8..5e6211798dc4 100644 --- a/base/FileIOShared.F90 +++ b/base/FileIOShared.F90 @@ -208,7 +208,7 @@ subroutine alloc_(A,type,im,jm,rc) _ASSERT(present(jm), 'jm not present for 2d') allocate(A%I4_2(IM,JM)) case default - _ASSERT(.false., 'unsupported tkr') + _FAIL( 'unsupported tkr') end select a%allocated=type @@ -254,7 +254,7 @@ subroutine dealloc_(A,RC) nullify(A%i4_2) end if case default - _ASSERT(.false., 'unsupported tkr') + _FAIL( 'unsupported tkr') end select a%allocated=not_allocated end if @@ -367,7 +367,7 @@ subroutine MAPL_TileMaskGet(grid, mask, rc) enddo #ifdef NEW - _ASSERT(.false., 'unsupported code block') !ALT this section is questionable + _FAIL( 'unsupported code block') !ALT this section is questionable do I = 0,nDEs-1 de = I I1 = AL(1,I) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 64428d1a29ad..f6726730615a 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -126,7 +126,7 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) tmp = attr_val attr_real32 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -155,7 +155,7 @@ function get_var_attr_real64(this,var_name,attr_name,rc) result(attr_real64) tmp = attr_val attr_real64 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -184,7 +184,7 @@ function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32) tmp = attr_val attr_int32 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -213,7 +213,7 @@ function get_var_attr_int64(this,var_name,attr_name,rc) result(attr_int64) tmp = attr_val attr_int64 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -240,7 +240,7 @@ function get_var_attr_string(this,var_name,attr_name,rc) result(attr_string) type is(character(*)) attr_string = attr_val class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -356,7 +356,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, endif endif class default - _ASSERT(.false.,"Time unit must be character") + _FAIL("Time unit must be character") end select call ESMF_TimeSet(unmodStartTime,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) _VERIFY(status) @@ -377,7 +377,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, type is (integer(kind=INT32)) tr_r64=ptr class default - _ASSERT(.false.,"unsupported time variable type") + _FAIL("unsupported time variable type") end select do i=1,tsize select case (trim(tUnits)) @@ -398,7 +398,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, _VERIFY(status) tvec(i)=unmodStartTime+tint case default - _ASSERT(.false.,"unsupported time unit") + _FAIL("unsupported time unit") end select enddo @@ -458,7 +458,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) type is (character(*)) units => vunits class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select else units => null() @@ -497,7 +497,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (character(*)) coordUnits = trim(coordUnitPtr) class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select end if @@ -514,7 +514,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (integer(kind=INT32)) coords=ptr class default - _ASSERT(.false.,"unsupported coordel variable type") + _FAIL("unsupported coordel variable type") end select end if _RETURN(_SUCCESS) diff --git a/base/MAPL_AbstractRegridder.F90 b/base/MAPL_AbstractRegridder.F90 index 3b7a1c55acb2..30ffeb83017e 100644 --- a/base/MAPL_AbstractRegridder.F90 +++ b/base/MAPL_AbstractRegridder.F90 @@ -120,7 +120,7 @@ subroutine regrid_scalar_2d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -136,7 +136,7 @@ subroutine regrid_scalar_2d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -152,7 +152,7 @@ subroutine regrid_scalar_3d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -168,7 +168,7 @@ subroutine regrid_scalar_3d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -187,7 +187,7 @@ subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -209,7 +209,7 @@ subroutine regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -230,7 +230,7 @@ subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -251,7 +251,7 @@ subroutine regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -321,7 +321,7 @@ subroutine regrid_esmf_fields_scalar(this, f_in, f_out, rc) end block case default - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -354,11 +354,11 @@ subroutine regrid_esmf_fields_scalar(this, f_in, f_out, rc) _VERIFY(status) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported type kind') + _FAIL( 'unsupported type kind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -445,7 +445,7 @@ subroutine regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -487,11 +487,11 @@ subroutine regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported type-kind') + _FAIL( 'unsupported type-kind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -509,7 +509,7 @@ subroutine transpose_regrid_scalar_2d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -524,7 +524,7 @@ subroutine transpose_regrid_scalar_2d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -539,7 +539,7 @@ subroutine transpose_regrid_scalar_3d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -555,7 +555,7 @@ subroutine transpose_regrid_scalar_3d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -575,7 +575,7 @@ subroutine transpose_regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -600,7 +600,7 @@ subroutine transpose_regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -625,7 +625,7 @@ subroutine transpose_regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -649,7 +649,7 @@ subroutine transpose_regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc) character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -721,7 +721,7 @@ subroutine transpose_regrid_esmf_fields_scalar(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -754,11 +754,11 @@ subroutine transpose_regrid_esmf_fields_scalar(this, f_in, f_out, rc) _VERIFY(status) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -845,7 +845,7 @@ subroutine transpose_regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -887,11 +887,11 @@ subroutine transpose_regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) diff --git a/base/MAPL_CFIO.F90 b/base/MAPL_CFIO.F90 index 0093464f5536..2032536719b1 100644 --- a/base/MAPL_CFIO.F90 +++ b/base/MAPL_CFIO.F90 @@ -475,7 +475,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, print*,'WARNING: CFIO parameter "order" is no longer used.' print*,' The new regrid facility uses ESMF parameters to' print*,' specify the type of regridding to perform.' - _ASSERT(.false., 'Order must be present') + _FAIL( 'Order must be present') MCFIO%Order = Order else MCFIO%Order = -1 @@ -739,7 +739,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, unGrdCoordCheck = .false. end if if ( unGrdUnitCheck .or. unGrdNameCheck .or. unGrdCoordCheck) then - _ASSERT(.false., 'Ungridded attributes for variables in collection do not match') + _FAIL( 'Ungridded attributes for variables in collection do not match') end if end if end do @@ -807,7 +807,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, LM = size(ULEVELS) HAVE_edge = .false. if (HAVE_ungrd) then - _ASSERT(.false., 'ERROR: Specifying LEVELS is not allowed for UNGRIDDED vars') + _FAIL( 'ERROR: Specifying LEVELS is not allowed for UNGRIDDED vars') end if else @@ -817,17 +817,17 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, DO I = 1, NumVars IF (LOCATION(I)==MAPL_VLocationEdge) print*, mCFIO%VarName(I) ENDDO - _ASSERT(.false., 'ERROR: Mixed Vlocation in CFIO not allowed unless LEVELS is specified') + _FAIL( 'ERROR: Mixed Vlocation in CFIO not allowed unless LEVELS is specified') endif if( all(MCFIO%VarDims==2)) then LM = 1 else if (HAVE_ungrd) then if (HAVE_center .or. HAVE_edge) then - _ASSERT(.false., 'ERROR: Mixed 3d and UNGRIDDED in CFIO not allowed') + _FAIL( 'ERROR: Mixed 3d and UNGRIDDED in CFIO not allowed') end if if (minval(vsize) /= maxval(vsize)) then - _ASSERT(.false., 'ERROR: Outputting variables with different ungridded sizes in one collection') + _FAIL( 'ERROR: Outputting variables with different ungridded sizes in one collection') end if LM = maxval(vsize) else @@ -958,7 +958,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, exit end do if (.not.foundEmpty) then - _ASSERT(.false., 'ERROR: Need bigger table with storedCoords') + _FAIL( 'ERROR: Need bigger table with storedCoords') end if end if endif @@ -995,7 +995,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, lons1d = MAPL_Range(-180.+(180./IMO), 180.-(180./IMO), IMO) lats1d = MAPL_Range(-90.+(90./JMO), +90.-(90./JMO), JMO) case default - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end select mcfio%xyoffset = xyoffset else @@ -5257,13 +5257,13 @@ subroutine MAPL_CFIOCreateFromFile(MCFIO,bundlein,RegridMethod,hw,only_vars,rc) end if else if (gridStagger == MAPL_DGrid) then if (rotation /= MAPL_RotateCube) then - _ASSERT(.false.,'must rotate LL') + _FAIL('must rotate LL') else mCFIO%doRotate = .false. end if else if (gridStagger == MAPL_CGrid) then if (rotation /= MAPL_RotateCube) then - _ASSERT(.false.,'must rotate LL') + _FAIL('must rotate LL') else mCFIO%doRotate = .false. end if diff --git a/base/MAPL_Comms.F90 b/base/MAPL_Comms.F90 index 9496479311bd..51d86ae8c747 100644 --- a/base/MAPL_Comms.F90 +++ b/base/MAPL_Comms.F90 @@ -464,7 +464,7 @@ subroutine MAPL_CreateRequest(grid, Root, request, tag, RequestType, & _VERIFY(STATUS) end if else - _ASSERT(.false., 'unsupported action') + _FAIL( 'unsupported action') end if ! Allocate a contiguous buffer for communication diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index f680ecf343fd..6dad03652172 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -316,7 +316,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi im = file_metadata%get_dimension('lon',rc=status) _VERIFY(status) else - _ASSERT(.false.,"can not identify dimenions of cubed-sphere file") + _FAIL("can not identify dimenions of cubed-sphere file") end if end associate call this%make_arbitrary_decomposition(this%nx, this%ny, reduceFactor=6, rc=status) @@ -332,7 +332,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%stretch_factor = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select attr => file_metadata%get_attribute('TARGET_LAT') attr_val => attr%get_values() @@ -340,7 +340,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%target_lon = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select attr => file_metadata%get_attribute('TARGET_LON') attr_val => attr%get_values() @@ -348,7 +348,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%target_lat = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select end if diff --git a/base/MAPL_LocStreamMod.F90 b/base/MAPL_LocStreamMod.F90 index 4d9ecc14ede2..220eef8a748b 100644 --- a/base/MAPL_LocStreamMod.F90 +++ b/base/MAPL_LocStreamMod.F90 @@ -233,7 +233,7 @@ subroutine MAPL_LocStreamGet(LocStream, NT_LOCAL, nt_global, TILETYPE, TILEKIND, if (present(tilekind)) then PRINT *, 'IN LocStreamGet TILEKIND NO LONGER VALID ARGUMENT' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') ! tilekind => locstream%Ptr%Local_GeoLocation(:)%u end if @@ -1912,11 +1912,11 @@ subroutine MAPL_LocStreamTransformT2G (LocStream, OUTPUT, INPUT, MASK, SAMPLE, T end if if (computeVariance .and. usableTranspose) then - _ASSERT(.false.,"Can not compute variance and transpose in LocStream!") + _FAIL("Can not compute variance and transpose in LocStream!") end if if (computeVariance .and. uSample) then - _ASSERT(.false.,"Can not compute variance and sample in LocStream!") + _FAIL("Can not compute variance and sample in LocStream!") end if ! Compute weighted average over masked locations @@ -2123,7 +2123,7 @@ subroutine MAPL_LocStreamTransformG2T ( LocStream, OUTPUT, INPUT, & if (usableGLOBAL) then PRINT *, 'IN G2T GLOBAL NO LONGER VALID ARGUMENT' - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') else do N = 1, size(OUTPUT) if(usableMASK(N)) then diff --git a/base/MAPL_TimeMethods.F90 b/base/MAPL_TimeMethods.F90 index c14719ea67b5..4dd8f5a2c832 100644 --- a/base/MAPL_TimeMethods.F90 +++ b/base/MAPL_TimeMethods.F90 @@ -145,7 +145,7 @@ function define_time_variable(this,rc) result(v) end if time_increment = this%frequency/86400 case default - _ASSERT(.false., 'Not supported yet') + _FAIL( 'Not supported yet') end select call this%tvec%clear() @@ -265,7 +265,7 @@ function get_start_time(this,metadata,rc) result(startTime) startTime = parse_time_string(units,rc=status) _VERIFY(status) class default - _ASSERT(.false.,'unsupported subclass for units') + _FAIL('unsupported subclass for units') end select @@ -296,7 +296,7 @@ function parse_time_string(timeUnits,rc) result(time) lastdash = index(TimeUnits, '-', BACK=.TRUE.) if (firstdash .LE. 0 .OR. lastdash .LE. 0) then - _ASSERT(.false.,'time string is not a valid format') + _FAIL('time string is not a valid format') endif ypos(2) = firstdash - 1 mpos(1) = firstdash + 1 diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 1d6d4d84f4a0..cba4dfb80418 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -395,7 +395,7 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) unGrdCoordCheck = .false. end if if ( unGrdUnitCheck .or. unGrdNameCheck .or. unGrdCoordCheck) then - _ASSERT(.false.,'Ungridded attributes for variables in collection do not match') + _FAIL('Ungridded attributes for variables in collection do not match') end if end if end do diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 14b9d7166a6f..f964b7d7f348 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -1047,7 +1047,7 @@ subroutine SOLAR_ARR_INT(LONS, LATS, ORBIT, ZTH, SLR, INTV, CLOCK, & ! Begin - _ASSERT(.FALSE.," pmn: this routine is not up to date, is it even used anywhere?") + _FAIL(" pmn: this routine is not up to date, is it even used anywhere?") call ESMF_ArrayGet(LONS, RANK=RANK, RC=STATUS) _VERIFY(STATUS) @@ -1998,7 +1998,7 @@ subroutine MAPL_SunGetSolarConstantByYearDoY(year,dayofyear,SC,HK, rc) HK(8) = ChouBand8(i1)*(1.-F) + ChouBand8(i2)*F _ASSERT(abs(1.0-sum(HK))<1.e-4,'Chou Solar band weightings do not sum to unity!') else - _ASSERT(.false.,'HK: Solar band weightings only available for Chou') + _FAIL('HK: Solar band weightings only available for Chou') endif end if @@ -2080,7 +2080,7 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error opening file ', trim(fileName), status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in dimensions @@ -2090,14 +2090,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting ndate dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_ndate, len = ndate) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting ndate length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if if (present(HK)) then @@ -2105,14 +2105,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_sorad dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_sorad, len = nbin_sorad) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_sorad length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2121,14 +2121,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_meso_phot dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_meso_phot, len = nbin_meso_phot) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_meso_phot length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2137,14 +2137,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_jcalc4 dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_jcalc4, len = nbin_jcalc4) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_jcalc4 length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2182,14 +2182,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_year varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_date_year, date_year) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_year variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in date_month @@ -2199,14 +2199,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_month varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_date_month, date_month) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_month variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in tsi @@ -2216,14 +2216,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting tsi varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_tsi, tsi) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting tsi variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in coef_sorad @@ -2235,14 +2235,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_sorad varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_sorad, coef_sorad) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_sorad variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2256,14 +2256,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_meso_phot varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_meso_phot, coef_meso_phot) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_meso_phot variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2277,14 +2277,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_jcalc4 varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_jcalc4, coef_jcalc4) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_jcalc4 variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if diff --git a/base/NCIO.F90 b/base/NCIO.F90 index 0480974a09e3..5868690ae01f 100644 --- a/base/NCIO.F90 +++ b/base/NCIO.F90 @@ -242,7 +242,7 @@ subroutine MAPL_FieldReadNCPar(formatter,name,FIELD, ARRDES, HomePE, RC) call ESMF_ArrayGet(array, localDE=0, farrayptr=var_4d, rc=status) _VERIFY(STATUS) if (.not.associated(var_4d)) then - _ASSERT(.false., "Cannot read unassociated variable") + _FAIL( "Cannot read unassociated variable") end if do L = 1,size(var_4d,3) @@ -254,10 +254,10 @@ subroutine MAPL_FieldReadNCPar(formatter,name,FIELD, ARRDES, HomePE, RC) end do end do else - _ASSERT(.false., "ERROR: unsupported RANK/KIND") + _FAIL( "ERROR: unsupported RANK/KIND") endif else - _ASSERT(.false., "ERROR: unsupported RANK") + _FAIL( "ERROR: unsupported RANK") endif _VERIFY(STATUS) @@ -381,7 +381,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients endif else - _ASSERT(.false., "Cannot write unassociated var-1d") + _FAIL( "Cannot write unassociated var-1d") end if else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_1d, rc=status) @@ -422,7 +422,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients endif else - _ASSERT(.false., "Cannot write unassociated var8-1d") + _FAIL( "Cannot write unassociated var8-1d") end if endif else if (rank == 2) then @@ -458,7 +458,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, var_2d, arrdes=arrdes, oClients=oClients, rc=status) endif ! dims else - _ASSERT(.false., "Cannot write unassociated var-2d") + _FAIL( "Cannot write unassociated var-2d") endif ! associated else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_2d, rc=status) @@ -491,7 +491,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, vr8_2d, arrdes=arrdes, oClients=oClients, rc=status) end if else - _ASSERT(.false., "Cannot write unassociated var8-2d") + _FAIL( "Cannot write unassociated var8-2d") end if endif else if (rank == 3) then @@ -532,7 +532,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, var_3d, arrdes=arrdes, oClients=oClients, rc=status) endif else - _ASSERT(.false., "Cannot write unassociated var-3d") + _FAIL( "Cannot write unassociated var-3d") end if else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_3d, rc=status) @@ -570,25 +570,25 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, vr8_3d, arrdes=arrdes, oClients=oClients, rc=status) end if else - _ASSERT(.false., "Cannot write unassociated var8-3d") + _FAIL( "Cannot write unassociated var8-3d") end if endif else if (rank == 4) then if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then - _ASSERT(.false., "Unsupported tile/ungrid variable") + _FAIL( "Unsupported tile/ungrid variable") end if if (tk == ESMF_TYPEKIND_R4) then call ESMF_ArrayGet(array, localDE=0, farrayptr=var_4d, rc=status) _VERIFY(STATUS) if (.not.associated(var_4d)) then - _ASSERT(.false., "Cannot write unassociated vars") + _FAIL( "Cannot write unassociated vars") end if call MAPL_VarWrite(formatter, name, var_4d, arrdes=arrdes, oClients=oClients, rc=status) else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_4d, rc=status) _VERIFY(STATUS) if (.not.associated(vr8_4d)) then - _ASSERT(.false., "Cannot write unassociated vars") + _FAIL( "Cannot write unassociated vars") end if call MAPL_VarWrite(formatter, name, vr8_4d, arrdes=arrdes, oClients=oClients, rc=status) endif @@ -2999,7 +2999,7 @@ subroutine MAPL_StateVarReadNCPar(filename, STATE, arrdes, bootstrapable, NAME, value=MAPL_RestartBootstrap, rc=status) else - _ASSERT(.false., " Could not find field "//trim(FieldName)//" in "//trim(filename)) + _FAIL( " Could not find field "//trim(FieldName)//" in "//trim(filename)) end if end if @@ -3053,7 +3053,7 @@ subroutine MAPL_StateVarReadNCPar(filename, STATE, arrdes, bootstrapable, NAME, call ESMF_AttributeSet ( field, name='RESTART', & value=MAPL_RestartBootstrap, rc=status) else - _ASSERT(.false., " Could not find field "//trim(Fieldname)//" in "//trim(filename)) + _FAIL( " Could not find field "//trim(Fieldname)//" in "//trim(filename)) end if end if @@ -3283,7 +3283,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) ! verify that file is compatible with fields in bundle we are reading if (nVars == 0) then - _ASSERT(.false., "The bundle you are trying to write is empty") + _FAIL( "The bundle you are trying to write is empty") endif ! first we need to prep the netcdf file for writing @@ -3374,7 +3374,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) UNGRID_DIMS(I,1) = size(var_4d,3) UNGRID_DIMS(I,2) = size(var_4d,4) else - _ASSERT(.false., "Unsupported DIMS type") + _FAIL( "Unsupported DIMS type") end if elseif (tk == ESMF_TYPEKIND_R8) then call ESMF_ArrayGet(array, localDE=0, farrayptr=var8_4d, rc=status) @@ -3385,10 +3385,10 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) UNGRID_DIMS(I,1) = size(var8_4d,3) UNGRID_DIMS(I,2) = size(var8_4d,4) else - _ASSERT(.false., "Unsupported DIMS type") + _FAIL( "Unsupported DIMS type") end if else - _ASSERT(.false., "Unsupported type/rank") + _FAIL( "Unsupported type/rank") endif endif @@ -3661,7 +3661,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'edge',units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 1') + _FAIL( 'ERROR: LOCATION not recognized for rank 1') endif elseif(DIMS(1)==MAPL_DimsTileOnly) then call add_fvar(cf,trim(fieldname),pfDataType,'tile',units,long_name,rc=status) @@ -3680,7 +3680,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,myUngridDimName1,units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'unsupported Dims case') + _FAIL( 'unsupported Dims case') endif else if(arrayRank == 2) then if (DIMS(1)==MAPL_DimsHorzOnly) then @@ -3701,7 +3701,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) _VERIFY(status) else write(buffer,*)'ERROR: DIMS not recognized for rank 2 variable ',trim(FieldName), DIMS(1) - _ASSERT(.false., trim(buffer)) + _FAIL( trim(buffer)) endif else if(arrayRank == 3) then @@ -3715,7 +3715,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'lon,lat,edge',units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 3') + _FAIL( 'ERROR: LOCATION not recognized for rank 3') endif else if(DIMS(1)==MAPL_DimsHorzOnly) then do j=1,n_unique_ungrid_dims @@ -3745,7 +3745,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'tile,'//myUngridDimName1//','//myUngridDimName2,units,long_name,rc=status) _VERIFY(status) else if(DIMS(1)/=MAPL_DimsHorzVert .and. DIMS(1)/=MAPL_DimsHorzOnly) then - _ASSERT(.false., 'ERROR: What else could it be') + _FAIL( 'ERROR: What else could it be') endif else if(arrayRank == 4) then if (DIMS(1)==MAPL_DimsHorzVert) then @@ -3763,7 +3763,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'lon,lat,edge,'//myUngridDimName1,units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 4') + _FAIL( 'ERROR: LOCATION not recognized for rank 4') endif else if(DIMS(1)==MAPL_DimsHorzOnly) then do j=1,n_unique_ungrid_dims @@ -3784,13 +3784,13 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) _VERIFY(status) else if (DIMS(1)==MAPL_DimsTileOnly .or. & DIMS(1)==MAPL_DimsTileTile) then - _ASSERT(.false., 'ERROR: tiles with 2 or more UNGRIDDED dims not supported') + _FAIL( 'ERROR: tiles with 2 or more UNGRIDDED dims not supported') else - _ASSERT(.false., 'ERROR: What else could it be') + _FAIL( 'ERROR: What else could it be') endif else write(buffer,*) 'ERROR: arrayRank ',arrayRank, ' not supported' - _ASSERT(.false., trim(buffer)) + _FAIL( trim(buffer)) endif enddo @@ -4379,7 +4379,7 @@ subroutine MAPL_IOGetTime(cf,nymd,nhms,rc) type is (character(*)) call MAPL_NCIOParseTimeUnits(units,year,month,day,hour,min,sec,status) class default - _ASSERT(.false., 'unsupported subclass for units') + _FAIL( 'unsupported subclass for units') end select nymd = year*10000 + month*100 + day nhms = hour*10000 + min*100 + sec @@ -4536,7 +4536,7 @@ function check_flip(metadata,rc) result(flip) type is (character(*)) positive => vpos class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select else positive => null() diff --git a/base/StringTemplate.F90 b/base/StringTemplate.F90 index 03ad68fe0f10..1b13af15edfa 100644 --- a/base/StringTemplate.F90 +++ b/base/StringTemplate.F90 @@ -110,7 +110,7 @@ subroutine fill_grads_template(output_string,template,unusable,experiment_id,nym output_string(k:k+1)="%s" k=k+1 else - _ASSERT(.false.,"Using %s token with no experiment id") + _FAIL("Using %s token with no experiment id") end if case("%") istp=2 @@ -133,7 +133,7 @@ subroutine fill_grads_template(output_string,template,unusable,experiment_id,nym output_string(k:m)=sbuf k=m+1 else - _ASSERT(.false.,"Invalid token in file template: "//c1//c2) + _FAIL("Invalid token in file template: "//c1//c2) end if end select else diff --git a/base/read_parallel.H b/base/read_parallel.H index 83e15b177188..79ba0ad55953 100644 --- a/base/read_parallel.H +++ b/base/read_parallel.H @@ -91,7 +91,7 @@ subroutine SUB_ ( layout, DATA, UNIT, FORMAT, arrdes, RC) #if (RANK_ > 2 || VARTYPE_ <= 0) - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') #else diff --git a/base/sun.H b/base/sun.H index 289607f2f2ea..bb58867bc8f4 100644 --- a/base/sun.H +++ b/base/sun.H @@ -108,7 +108,7 @@ ! pmn: EOT will just displace sunlit period wrt mean noon, ! but the daily mean values will not change - _ASSERT(.FALSE.,'pmn: MAPL_SunDailyMean probably in error!') + _FAIL('pmn: MAPL_SunDailyMean probably in error!') _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = sin(LATS)*ORBIT%ZS(IDAY) @@ -149,7 +149,7 @@ ! its a mean over the whole currently fixed 4-year cycle. ! see above - _ASSERT(.FALSE.,'pmn: MAPL_SunAnnualMean probably in error!') + _FAIL('pmn: MAPL_SunAnnualMean probably in error!') _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = 0.0 diff --git a/base/tests/mapl_bundleio_test.F90 b/base/tests/mapl_bundleio_test.F90 index b7006fa3c884..771cc49f38d7 100644 --- a/base/tests/mapl_bundleio_test.F90 +++ b/base/tests/mapl_bundleio_test.F90 @@ -237,7 +237,7 @@ subroutine compare_bundle(State1,State2,tol,rc) enddo end if if (foundDiff(ii)) then - _ASSERT(.false.,'found difference when compare state') + _FAIL('found difference when compare state') end if enddo diff --git a/base/write_parallel.H b/base/write_parallel.H index 5f2e8f343bca..823ce1c74a52 100644 --- a/base/write_parallel.H +++ b/base/write_parallel.H @@ -87,7 +87,7 @@ subroutine SUB_ ( data, UNIT, ARRDES, format, RC) #if (RANK_ > 2 || VARTYPE_ <= 0) - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') #else diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index 80bc16d4bfb6..12cde4206720 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -1468,7 +1468,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - _ASSERT(.false., "Unsupported rank") + _FAIL( "Unsupported rank") end select _DEALLOC(mask) end do @@ -1591,7 +1591,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) case(3) local_undefs = associated(state%array_count(i)%ptr3c) case default - _ASSERT(.false., "Unsupported rank") + _FAIL( "Unsupported rank") end select have_undefs = 0 n_undefs = 0 @@ -1662,7 +1662,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - _ASSERT(.false.," Unsupported rank") + _FAIL(" Unsupported rank") end select _DEALLOC(mask) end do @@ -1710,7 +1710,7 @@ subroutine MAPL_CplCompSetAlarm ( CC, ALARM, RC ) if (.not.associated(STATE%TIME2CPL_ALARM)) then STATE%TIME2CPL_ALARM => ALARM else - _ASSERT(.false., "Alarm is already associated! Cannot set it again!") + _FAIL( "Alarm is already associated! Cannot set it again!") end if _RETURN(ESMF_SUCCESS) end subroutine MAPL_CplCompSetAlarm diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 78bbca59b2d6..bb5c57454c26 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -2099,7 +2099,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1)) if(FILETYPE=='pnc4' .and. nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif #endif call MAPL_GetResource( STATE , hdr, & @@ -2129,7 +2129,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1)) if(FILETYPE=='pnc4' .and. nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif #endif call MAPL_ESMFStateWriteToFile(IMPORT,CLOCK,FILENAME, & @@ -5674,7 +5674,7 @@ subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, oCli #ifndef H5_HAVE_PARALLEL if (nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if #endif AmWriter = mpl%grid%writers_comm/=MPI_COMM_NULL @@ -6062,7 +6062,7 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) #ifndef H5_HAVE_PARALLEL if (nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if #endif AmReader = mpl%grid%readers_comm/=MPI_COMM_NULL @@ -8376,7 +8376,7 @@ subroutine MAPL_GetResourceFromConfig_scalar(config, val, label, default, rc) _VERIFY(status) end if class default - _ASSERT(.false., "Unupported type") + _FAIL( "Unupported type") end select call ESMF_ConfigGetAttribute(config, printrc, label = 'PRINTRC:', default = 0, rc = status) @@ -8501,7 +8501,7 @@ subroutine MAPL_GetResource_array(state, vals, label, default, rc) _VERIFY(status) end if class default - _ASSERT(.false., "Unsupported type") + _FAIL( "Unsupported type") end select _RETURN(ESMF_SUCCESS) @@ -8573,7 +8573,7 @@ subroutine print_resource(printrc, label, val, default, rc) default_str = intrinsic_to_string(default, 'a') end if class default - _ASSERT(.false.,"Unsupported type") + _FAIL("Unsupported type") end select output_format = "(1x, " // type_str // ", 'Resource Parameter: '" // ", a"// ", a)" @@ -8634,7 +8634,7 @@ function intrinsic_to_string(val, str_format, rc) result(formatted_str) type is(character(len=*)) formatted_str = trim(val) class default - _ASSERT(.false., "Unsupported type in intrinsic_to_string") + _FAIL( "Unsupported type in intrinsic_to_string") end select end function intrinsic_to_string @@ -9334,7 +9334,7 @@ subroutine MAPL_ReadForcingX(MPL,NAME,DATAFILE,CURRTIME, & elseif(present(FORCING2)) then ONED = .FALSE. else - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') end if ! Get parameters from generic state. @@ -9964,7 +9964,7 @@ subroutine READIT(WHICH) if(TRANSFORM) then if (PRF /= 0) then - _ASSERT(.false.,'needs informative message') ! for now + _FAIL('needs informative message') ! for now else ! ALT this LOOKS WRONG. MAPL_VarRead needs a mask for tiles!!! call MAPL_VarRead(UNIT, GRID, VAR2, RC=status ) @@ -10154,7 +10154,7 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) elseif(present(MAPLOBJ)) then STATE => MAPLOBJ else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif call MAPL_ConfigPrepend(state%cf,trim(comp_name),MAPL_CF_COMPONENT_SEPARATOR,'NX:',rc=status) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 15c27fb5c7ea..a87fc8b04865 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -11,7 +11,7 @@ MODULE MAPL_ExtDataGridCompMod !BOP ! !MODULE: MAPL_ExtDataGridCompMod - Implements Interface to External Data ! -! !DESCRIPTION: +! !DESCRIPTION: ! ! {\tt MAPL\_ExtDataGridComp} is an ESMF gridded component implementing ! an interface to boundary conditions and other types of external data @@ -131,12 +131,12 @@ MODULE MAPL_ExtDataGridCompMod ! the corresponding names of the two vector components on file character(len=ESMF_MAXSTR) :: fcomp1, fcomp2 type(GriddedIOitem) :: fileVars - type(SimpleAlarm) :: update_alarm + type(SimpleAlarm) :: update_alarm integer :: collection_id integer :: pfioCollection_id integer :: iclient_collection_id - + logical :: ExtDataAlloc ! time shifting during continuous update type(ESMF_TimeInterval) :: tshift @@ -157,7 +157,7 @@ MODULE MAPL_ExtDataGridCompMod PRIVATE integer :: nItems = 0 logical :: have_phis - type(PrimaryExport), pointer :: item(:) => null() + type(PrimaryExport), pointer :: item(:) => null() end type PrimaryExports type DerivedExport @@ -232,7 +232,7 @@ SUBROUTINE SetServices ( GC, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional :: RC ! return code -! !DESCRIPTION: Sets Initialize, Run and Finalize services. +! !DESCRIPTION: Sets Initialize, Run and Finalize services. ! ! !REVISION HISTORY: ! @@ -263,7 +263,7 @@ SUBROUTINE SetServices ( GC, RC ) allocate ( self, stat=STATUS ) _VERIFY(STATUS) wrap%ptr => self - + ! ------------------------ ! ESMF Functional Services ! ------------------------ @@ -273,12 +273,12 @@ SUBROUTINE SetServices ( GC, RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, __RC__ ) - + ! Store internal state in GC ! -------------------------- call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) _VERIFY(STATUS) - + ! Generic Set Services ! -------------------- @@ -319,7 +319,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -332,7 +332,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(MAPL_ExtData_state), pointer :: self ! Legacy state type(ESMF_Grid) :: GRID ! Grid - type(ESMF_Config) :: CF_main ! Universal Config + type(ESMF_Config) :: CF_main ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -342,7 +342,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(PrimaryExports) :: Primary type(PrimaryExport), pointer :: item type(DerivedExports) :: Derived - type(DerivedExport), pointer :: derivedItem + type(DerivedExport), pointer :: derivedItem integer :: nLines integer :: i integer :: ItemCount, itemCounter, j @@ -408,7 +408,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Start Some Timers ! ----------------- call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"Initialize") ! Get information from export state @@ -476,9 +476,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) totalPrimaryEntries=0 totalDerivedEntries=0 call ESMF_ConfigNextLine(CFtemp,__RC__) - do while (status == ESMF_SUCCESS) + do while (status == ESMF_SUCCESS) call ESMF_ConfigNextLine(CFtemp,rc=status) - if (status == ESMF_SUCCESS) then + if (status == ESMF_SUCCESS) then call ESMF_ConfigGetAttribute(CFtemp,thisLine,rc=status) _VERIFY(STATUS) if (trim(thisLine) == "PrimaryExports%%" .or. trim(thisLine) == "DerivedExports%%" ) then @@ -509,14 +509,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) allocate(primary%item(totalPrimaryEntries), stat=STATUS) _VERIFY(STATUS) end if - + derived%nItems = totalDerivedEntries - if (totalDerivedEntries > 0) then + if (totalDerivedEntries > 0) then Allocate(DerivedVarNeeded(totalDerivedEntries),stat=status) _VERIFY(STATUS) DerivedVarNeeded = .false. allocate(derived%item(totalDerivedEntries),stat=status) - _VERIFY(STATUS) + _VERIFY(STATUS) end if ! Primary Exports @@ -530,7 +530,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ConfigLoadFile(CFtemp,EXTDATA_CF,rc=status) _VERIFY(STATUS) call ESMF_ConfigNextLine(CFtemp,__RC__) - do while(status == ESMF_SUCCESS) + do while(status == ESMF_SUCCESS) call ESMF_ConfigNextLine(CFtemp,rc=status) if (status == ESMF_SUCCESS) then @@ -628,7 +628,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primary%item(totalPrimaryEntries)%do_scale = .true. read(c_scale,*,iostat=ios) primary%item(totalPrimaryEntries)%scale end if - + ! variable name on file entry call ESMF_ConfigGetAttribute(CFtemp, primary%item(totalPrimaryEntries)%var, __RC__) ! file template entry @@ -643,8 +643,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primary%item(totalPrimaryEntries)%hasFileReffTime = .false. else primary%item(totalPrimaryEntries)%hasFileReffTime = .true. - end if - + end if + ! assume we will allocate primary%item(totalPrimaryEntries)%ExtDataAlloc = .true. ! check if this is going to be a constant @@ -685,7 +685,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if end if end do - !Done parsing resource file + !Done parsing resource file PrimaryItemCount = 0 DerivedItemCount = 0 @@ -741,14 +741,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) itemCounter = itemCounter + 1 found = .true. if (primary%item(j)%isConst .and. ITEMTYPES(I) == ESMF_StateItem_FieldBundle) then - _ASSERT(.false., 'Can not have constant bundle in ExtData.rc file') + _FAIL( 'Can not have constant bundle in ExtData.rc file') end if PrimaryItemCount = PrimaryItemCount + 1 PrimaryVarNeeded(j) = .true. primary%item(j)%ExtDataAlloc = .false. VarName=trim(primary%item(J)%name) primary%item(j)%fileVars%xname=trim(primary%item(J)%var) - + if (ITEMTYPES(I) == ESMF_StateItem_Field) then primary%item(J)%vartype = MAPL_FieldItem call ESMF_StateGet(Export,VarName,field,__RC__) @@ -768,7 +768,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (ItemNames(I) == derived%item(J)%name) then if (ITEMTYPES(I) == ESMF_StateItem_FieldBundle) then - _ASSERT(.false.,'Derived items cannot be field bundle') + _FAIL('Derived items cannot be field bundle') end if found = .true. DerivedVarNeeded(j) = .true. @@ -788,15 +788,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if end do - call ESMF_VMGetCurrent(VM) + call ESMF_VMGetCurrent(VM) call ESMF_VMBarrier(VM) - + ! we have better found all the items in the export in either a primary or derived item if (itemCounter /= ItemCount) then write(error_msg_str, '(A6,I3,A31)') 'Found ', ItemCount-itemCounter,' unfulfilled imports in extdata' - _ASSERT(.false., error_msg_str) + _FAIL( error_msg_str) end if - + NumVarNames=primary%nItems allocate(VarNames(NumVarNames)) allocate(LocalVarNeeded(NumVarNames)) @@ -843,7 +843,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_StateGet(self%ExtDataState,VarName,field,__RC__) VarName=trim(primary%item(j)%name) fieldnew = MAPL_FieldCreate(field,varname,doCopy=.true.,__RC__) - primary%item(j)%fileVars%xname=trim(primary%item(j)%var) + primary%item(j)%fileVars%xname=trim(primary%item(j)%var) call MAPL_StateAdd(self%ExtDataState,fieldnew,__RC__) PrimaryVarNeeded(j) = .true. primary%item(j)%ExtDataAlloc = .true. @@ -897,7 +897,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if ( .not. item%isConst ) then call CreateTimeInterval(item,clock,__RC__) end if - + item%pfioCollection_id = MAPL_DataAddCollection(item%file,use_file_coords=self%use_file_coords) ! parse refresh template to see if we have a time shift during constant updating @@ -949,30 +949,30 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ptr3d = item%const endif else if (item%vartype == MAPL_BundleItem) then - _ASSERT(.false.,'Cannot assign constant to field bundle') + _FAIL('Cannot assign constant to field bundle') else if (item%vartype == MAPL_ExtDataVectorItem) then call ESMF_StateGet(self%ExtDataState,trim(item%vcomp1),field,__RC__) call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then + if (fieldRank == 2) then call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp1),__RC__) ptr2d = item%const - else if (fieldRank == 3) then + else if (fieldRank == 3) then call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp1), __RC__) ptr3d = item%const endif call ESMF_StateGet(self%ExtDataState,trim(item%vcomp2),field,__RC__) call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then + if (fieldRank == 2) then call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp2),__RC__) ptr2d = item%const - else if (fieldRank == 3) then + else if (fieldRank == 3) then call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp2), __RC__) ptr3d = item%const endif end if cycle end if - + ! check if this is a single piece of data if user put - for refresh template ! by that it is an untemplated file with one time that could not possibly be time interpolated if (PrimaryExportIsConstant_(item)) then @@ -1003,7 +1003,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (fieldRank==3) then call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) lm = size(ptr3d,3) - end if + end if if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then item%do_VertInterp = .true. else if (item%lm /= lm .and. lm /= 0) then @@ -1026,9 +1026,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_FieldBundleSet(item%binterp2, GRID=GRID, __RC__) call MAPL_CFIORead(item%file,time,item%binterp1,noread=.true.,ignorecase=self%ignorecase,only_vars=item%var,__RC__) call MAPL_CFIORead(item%file,time,item%binterp2,noread=.true.,ignorecase=self%ignorecase,only_vars=item%var,__RC__) - + else if (item%vartype == MAPL_ExtDataVectorItem) then - + ! Only some methods are supported for vector regridding _ASSERT(any(item%Trans /= [REGRID_METHOD_BILINEAR,REGRID_METHOD_CONSERVE_HFLUX]), 'Regrid method unsupported for vectors.') @@ -1044,7 +1044,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) - lm = 0 + lm = 0 if (fieldRank==3) then call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) lm = size(ptr3d,3) @@ -1107,7 +1107,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) print *, trim(Iam)//': IMPORT State during Initialize():' call ESMF_StatePrint ( IMPORT ) print * - print *, trim(Iam)//': EXPORT State during Initialize():' + print *, trim(Iam)//': EXPORT State during Initialize():' call ESMF_StatePrint ( EXPORT ) end if #endif @@ -1126,7 +1126,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) idx =i end if if (self%primary%item(i)%vartype==MAPL_BundleItem) then - _ASSERT(.false.,'Cannot perform vertical interpolation on field bundle') + _FAIL('Cannot perform vertical interpolation on field bundle') end if enddo _ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') @@ -1143,7 +1143,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) idx =i end if if (self%primary%item(i)%vartype==MAPL_BundleItem) then - _ASSERT(.false.,'Cannot perform vertical interpolation on field bundle') + _FAIL('Cannot perform vertical interpolation on field bundle') end if enddo if (idx/=-1) then @@ -1165,7 +1165,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (allocated(DerivedVarNeeded)) deallocate(DerivedVarNeeded) if (allocated(LocalVarNeeded)) deallocate(LocalVarNeeded) - !Done parsing resource file + !Done parsing resource file ! Set has run to false to we know when we first go to run method it is first call hasRun = .false. @@ -1208,7 +1208,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -1222,7 +1222,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(MAPL_ExtData_state), pointer :: self ! Legacy state type(ESMF_Field) :: field ! Field type(ESMF_FieldBundle) :: bundle - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -1253,10 +1253,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) -! Declare pointers to IMPORT/EXPORT/INTERNAL states +! Declare pointers to IMPORT/EXPORT/INTERNAL states ! ------------------------------------------------- ! #include "MAPL_ExtData_DeclarePointer___.h" - + ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'Run_' @@ -1278,13 +1278,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"Run") call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) -! Fill in the internal state with data from the files +! Fill in the internal state with data from the files ! --------------------------------------------------- allocate(doUpdate(self%primary%nitems),stat=status) @@ -1294,7 +1294,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") - + call lgr%debug('ExtData Rune_(): Start') call lgr%debug('ExtData Run_(): READ_LOOP: Start') @@ -1335,7 +1335,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! update left time call lgr%debug(' ExtData Run_: HAS_RUN: NotSingle is true. Update left time (bracket L)') - call UpdateBracketTime(item,time,"L",item%interp_time1, & + call UpdateBracketTime(item,time,"L",item%interp_time1, & item%time1,file_processed1,self%allowExtrap,rc=status) _VERIFY(status) call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i),file_processed1,MAPL_ExtDataLeft,item%tindex1,__RC__) @@ -1362,7 +1362,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call lgr%debug(' ExtData Run_: HAS_RUN: End') endif HAS_RUN - + ! now update bracketing times if neccessary NOT_SINGLE: if (NotSingle) then @@ -1483,9 +1483,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---IclientDone") _VERIFY(STATUS) - + call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") - call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) + call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) _VERIFY(status) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") @@ -1506,7 +1506,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") call MAPL_TimerOn(MAPLSTATE,"-Interpolate") - + call lgr%debug('ExtData Run_: INTERP_LOOP: Start') INTERP_LOOP: do i = 1, self%primary%nItems @@ -1517,13 +1517,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & & trim(item%var), trim(item%file)) - + ! finally interpolate between bracketing times if (item%vartype == MAPL_FieldItem) then call ESMF_StateGet(self%ExtDataState, item%name, field, __RC__) - call MAPL_ExtDataInterpField(item,useTime(i),field,__RC__) + call MAPL_ExtDataInterpField(item,useTime(i),field,__RC__) else if (item%vartype == MAPL_BundleItem) then @@ -1543,12 +1543,12 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_ExtDataInterpField(item,useTime(i),field,vector_comp=1,__RC__) call ESMF_StateGet(self%ExtDataState, item%vcomp2, field, __RC__) call MAPL_ExtDataInterpField(item,useTime(i),field,vector_comp=2,__RC__) - + end if endif - nullify(item) + nullify(item) end do INTERP_LOOP @@ -1618,7 +1618,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -1630,7 +1630,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -1688,7 +1688,7 @@ subroutine extract_ ( GC, self, CF, rc) type(ESMF_GridComp), intent(INout) :: GC ! Grid Comp object type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config), intent(out) :: CF ! Universal Config + type(ESMF_Config), intent(out) :: CF ! Universal Config integer, intent(out), optional :: rc @@ -1718,20 +1718,20 @@ subroutine extract_ ( GC, self, CF, rc) ! --------------------- call ESMF_GridCompGet ( GC, config=CF, __RC__ ) - + _RETURN(ESMF_SUCCESS) end subroutine extract_ - + ! ............................................................................ logical function PrimaryExportIsConstant_(item) - + type(PrimaryExport), intent(in) :: item if ( trim(item%refresh_template) == '-' .or. & trim(item%file) == '/dev/null' ) then - PrimaryExportIsConstant_ = .true. + PrimaryExportIsConstant_ = .true. else PrimaryExportIsConstant_ = .false. end if @@ -1741,11 +1741,11 @@ end function PrimaryExportIsConstant_ ! ............................................................................ logical function DerivedExportIsConstant_(item) - + type(DerivedExport), intent(in) :: item if ( trim(item%refresh_template) == '-') then - DerivedExportIsConstant_ = .true. + DerivedExportIsConstant_ = .true. else DerivedExportIsConstant_ = .false. end if @@ -1793,7 +1793,7 @@ end subroutine scale_field_ type (ESMF_Time) function timestamp_(time, template, rc) type(ESMF_Time), intent(inout) :: time character(len=ESMF_MAXSTR), intent(in) :: template - integer, optional, intent(inout) :: rc + integer, optional, intent(inout) :: rc ! locals integer, parameter :: DATETIME_MAXSTR_ = 32 @@ -1804,23 +1804,23 @@ type (ESMF_Time) function timestamp_(time, template, rc) integer :: i, il, ir integer :: status - + ! test the length of the timestamp template _ASSERT(len_trim(template) < DATETIME_MAXSTR_,'Timestamp template is greater than Maximum allowed len') buff = trim(template) buff = ESMF_UtilStringLowerCase(buff, __RC__) - + ! test if the template is empty and return the current time as result if (buff == '-' .or. buff == '--' .or. buff == '---' .or. & buff == 'na' .or. buff == 'none' .or. buff == 'n/a') then timestamp_ = time - else + else ! split the time stamp template into a date and time strings i = scan(buff, 't') If (.not.(i > 3)) Then - _ASSERT(.False.,'ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') + _FAIL('ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') End If buff_date = buff(1:i-1) @@ -1839,7 +1839,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) str_hs = trim(buff_time(1:il-1)) str_ms = trim(buff_time(il+1:ir-1)) str_ss = trim(buff_time(ir+1:)) - + ! remove the trailing 'Z' from the seconds string i = scan(str_ss, 'z') if (i > 0) then @@ -1862,7 +1862,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) _RETURN(ESMF_SUCCESS) end function timestamp_ - + subroutine CreateTimeInterval(item,clock,rc) type(PrimaryExport) , intent(inout) :: item type(ESMF_Clock) , intent(in ) :: clock @@ -1874,16 +1874,16 @@ subroutine CreateTimeInterval(item,clock,rc) type(ESMF_Time) :: time,start_time integer :: cindex,pindex character(len=ESMF_MAXSTR) :: creffTime, ctInt - + integer :: status logical :: found - + creffTime = '' ctInt = '' call ESMF_ClockGet (CLOCK, currTIME=time, startTime=start_time, __RC__) if (.not.item%hasFileReffTime) then ! if int_frequency is less than zero than try to guess it from the file template - ! if that fails then it must be a single file or a climatology + ! if that fails then it must be a single file or a climatology call ESMF_TimeGet(time, yy=iyy, mm=imm, dd=idd,h=ihh, m=imn, s=isc ,__RC__) !======================================================================= @@ -1936,10 +1936,10 @@ subroutine CreateTimeInterval(item,clock,rc) ! 1985-01-01T00:00:00P0001-00-00T00:00:00 ! Get refference time, if not provided use current model date pindex=index(item%FileReffTime,'P') - if (pindex==0) then - _ASSERT(.false., 'ERROR: File template ' // item%file // ' has invalid reference date format') + if (pindex==0) then + _FAIL( 'ERROR: File template ' // item%file // ' has invalid reference date format') end if - cReffTime = item%FileReffTime(1:pindex-1) + cReffTime = item%FileReffTime(1:pindex-1) if (trim(cReffTime) == '') then item%reff_time = Time else @@ -1955,7 +1955,7 @@ subroutine CreateTimeInterval(item,clock,rc) call MAPL_NCIOParseTimeUnits(ctInt,iyy,imm,idd,ihh,imn,isc,status) _VERIFY(STATUS) call ESMF_TimeIntervalSet(item%frequency,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) - _VERIFY(STATUS) + _VERIFY(STATUS) end if if (lgr%isEnabledFor(DEBUG)) then @@ -1965,7 +1965,7 @@ subroutine CreateTimeInterval(item,clock,rc) call ESMF_TimeIntervalGet(item%frequency,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) call lgr%debug(' >> Frequency : %i0.4~-%i0.2~-%i0.2 %i0.2~:%i0.2~:%i0.2', iYy, iMm, iDd, iHh, iMn, iSc) endif - _RETURN(ESMF_SUCCESS) + _RETURN(ESMF_SUCCESS) end subroutine CreateTimeInterval @@ -2024,7 +2024,7 @@ subroutine GetClimYear(item, rc) item%climYear = climYear _RETURN(ESMF_SUCCESS) else - _ASSERT(.false., 'cyclic keyword was not y, n, or a valid year (0 < year < 3000)') + _FAIL( 'cyclic keyword was not y, n, or a valid year (0 < year < 3000)') end if end if @@ -2045,12 +2045,12 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) integer :: nymd, nhms, rank type(ESMF_Time) :: fTime type(ESMF_Field) :: field - real, allocatable :: levFile(:) + real, allocatable :: levFile(:) character(len=ESMF_MAXSTR) :: buff,levunits,tlevunits,temp_name logical :: found,lFound,intOK integer :: maxOffset character(len=:), allocatable :: levname - character(len=:), pointer :: positive + character(len=:), pointer :: positive type(FileMetadataUtils), pointer :: metadata type(Variable), pointer :: var type(ESMF_TimeInterval) :: zero @@ -2074,7 +2074,7 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) end if if (item%frequency == zero) then - + file = item%file Inquire(file=trim(file),EXIST=found) @@ -2129,10 +2129,10 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) enddo if (.not.lfound) then - _ASSERT(.false., 'From ' // trim(item%file) // ' could not find file with extrapolation') + _FAIL( 'From ' // trim(item%file) // ' could not find file with extrapolation') end if else - _ASSERT(.false.,'From ' // trim(item%file) // ' could not find time no extrapolation') + _FAIL('From ' // trim(item%file) // ' could not find time no extrapolation') end if end if @@ -2148,7 +2148,7 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) var=>metadata%get_variable(trim(item%var)) _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file)) end if - + levName = metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then @@ -2239,7 +2239,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed UniFileClim = .false. ! if the file is constant, i.e. no tokens in in the template - ! but it was marked as cyclic we must have a year long climatology + ! but it was marked as cyclic we must have a year long climatology ! on one file, set UniFileClim to true if (trim(item%cyclic)=='y') UniFileClim = .true. file_processed = item%file @@ -2255,7 +2255,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%error('Bracket timing request failed on fixed file %a for side %a', trim(item%file), bSide) _RETURN(ESMF_FAILURE) end if - else + else if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' UpdateBracketTime: Scanning template %a for side %a1',trim(item%file), bSide) @@ -2275,14 +2275,14 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed else yrOffset = 0 if (item%reff_time > cTime) then - _ASSERT(.False.,'Reference time for file ' // trim(item%file) // ' is too late') + _FAIL('Reference time for file ' // trim(item%file) // ' is too late') end if ! This approach causes a problem if cTime and item%reff_time are too far - ! apart - do it the hard way instead... + ! apart - do it the hard way instead... ftime = item%reff_time n = 0 ! SDE DEBUG: This caused problems in the past but the - ! alternative is far too slow... need to keep an eye + ! alternative is far too slow... need to keep an eye ! on this but the Max(0,...) should help. n = max(0,floor((cTime-item%reff_time)/item%frequency)) if (n>0) fTime = fTime + (n*item%frequency) @@ -2316,7 +2316,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed if (found) then call lgr%debug(' Target file for %a found and is %a', trim(item%file), trim(file_processed)) !yrOffset = 0 - Else if (allowExtrap) then + Else if (allowExtrap) then if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' UpdateBracketTime: Target file not found: %a', trim(item%file)) @@ -2428,7 +2428,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed do while (ftime > newTime) fTime = fTime - item%frequency n = n - 1 - end do + end do ! untemplate file call ESMF_TimeGet(fTime,yy=iyr,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) call MAPL_PackTime(curDate,iyr,imm,idd) @@ -2458,7 +2458,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed ! question could actually be for a different year. We therefore feed the file time ! into the refresh template and see if the result has the same year. If it doesn't, ! then we can assume that the year is actually fixed, and the times in the file will - ! correspond to the year in the refresh template. In this case, an additional year + ! correspond to the year in the refresh template. In this case, an additional year ! offset must be applied. yrOffsetStamp = 0 buff = trim(item%refresh_template) @@ -2479,7 +2479,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%debug(' UpdateBracketTime: Found status of %a~: %l1', trim(file_processed), found) ! if we didn't find the bracketing time look forwards or backwards depending on - ! whether it is the right or left time + ! whether it is the right or left time if (.not.found) then call lgr%debug(' UpdateBracketTime: Scanning for bracket %a1 of %a~. RSide: %l1', bSide, trim(file_processed), (bSide=="R")) @@ -2584,7 +2584,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed buff = ESMF_UtilStringLowerCase(buff, __RC__) If (buff /= "0" .and. index(buff,"p")==0 ) Then newTime = timestamp_(fTime,item%refresh_template,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call ESMF_TimeGet(fTime,yy=iyr,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) call ESMF_TimeGet(newTime,yy=fyr,mm=fmm,dd=fdd,h=fhr,m=fmn,s=fsc,__RC__) @@ -2636,9 +2636,9 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%info(' ... file processed: %a', trim(file_processed)) _RETURN(ESMF_SUCCESS) - + end subroutine UpdateBracketTime - + subroutine swapBracketInformation(item,rc) type(PrimaryExport), intent(inout) :: item integer, optional, intent(out) :: rc @@ -2675,7 +2675,7 @@ subroutine swapBracketInformation(item,rc) do j = 1,fieldCount call ESMF_FieldBundleGet(item%binterp1, names(j), field=field1, __RC__) call ESMF_FieldBundleGet(item%binterp2, names(j), field=field2, __RC__) - call ESMF_FieldGet(field1, dimCount=fieldRank, __RC__) + call ESMF_FieldGet(field1, dimCount=fieldRank, __RC__) if (fieldRank == 2) then call ESMF_FieldGet(field1, localDE=0, farrayPtr=var2d_prev, __RC__) call ESMF_FieldGet(field2, localDE=0, farrayPtr=var2d_next, __RC__) @@ -2743,7 +2743,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) allocate(tSeriesInt(cfio%tSteps)) call getDateTimeVec(cfio%fid,begDate,begTime,tSeriesInt,__RC__) - + ! Assume success If (present(rc)) rc=ESMF_SUCCESS @@ -2757,7 +2757,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) call MAPL_UnpackTime(nymdB,iyr,imm,idd) call MAPL_UnpackTime(nhmsB,ihr,imn,isc) - + if (lgr%isEnabledFor(DEBUG) .and. any(i == [1,cfio%tsteps])) then call lgr%debug(' ==> STD Sample %i~: %i0.4~-%i0.2~-%i0.2 %i0.2~:%i0.2~:%i0.2', i, iYr, iMm, iDd, iHr, iMn, iSc) end if @@ -2770,7 +2770,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) end subroutine GetTimesOnFile subroutine OffsetTimeYear(inTime,yrOffset,outTime,rc) - + type(ESMF_Time), intent(in ) :: inTime integer :: yrOffset type(ESMF_Time), intent(out ) :: outTime @@ -2841,7 +2841,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte nsteps = size(tSeries) call ESMF_TimeGet(cTime,yy=targYear,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' GetBracketTimeOnSingleFile called for %a', trim(fdata%get_file_name())) call lgr%debug(' GetBracketTimeOnSingleFile: Reading times from fixed (%l1) file %a', UniFileClim, trim(fdata%get_file_name())) @@ -2875,7 +2875,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte end if end do - + allocate(tSeriesC(tsteps),__STAT__) do i=1,tsteps tSeriesC(i)=tSeries(iEntry+i-1) @@ -2934,7 +2934,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte end if end do end if - end if + end if else @@ -2946,7 +2946,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte RSide = (.not.LSide) LExact = (cLimTime == tSeries(1)) RExact = (cLimTime == tSeries(nsteps)) - LExtrap = (cLimTime < tSeries(1)) + LExtrap = (cLimTime < tSeries(1)) RExtrap = (cLimTime > tSeries(nsteps)) found = .false. @@ -3104,7 +3104,7 @@ subroutine GetBracketTimeOnFile(fdata,tSeries,cTime,bSide,UniFileClim,interpTime call OffsetTimeYear(cTime,yrOffset,cLimTime,rc) else climTime = cTime - end if + end if climSize = 1 ! Debug output @@ -3180,15 +3180,15 @@ subroutine GetBracketTimeOnFile(fdata,tSeries,cTime,bSide,UniFileClim,interpTime call lgr%error('Requested sample not found in file %a ', trim(fdata%get_file_name())) _RETURN(ESMF_FAILURE) endif - !end if + !end if end subroutine GetBracketTimeOnFile subroutine CalcDerivedField(state,exportName,exportExpr,masking,rc) type(ESMF_State), intent(inout) :: state - character(len=*), intent(in ) :: exportName + character(len=*), intent(in ) :: exportName character(len=*), intent(in ) :: exportExpr - logical, intent(in ) :: masking + logical, intent(in ) :: masking integer, optional, intent(out ) :: rc integer :: status @@ -3218,7 +3218,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) real :: alpha real, pointer :: var2d(:,:) => null() real, pointer :: var3d(:,:,:) => null() - real, pointer :: var2d_prev(:,:) => null() + real, pointer :: var2d_prev(:,:) => null() real, pointer :: var2d_next(:,:) => null() real, pointer :: var3d_prev(:,:,:) => null() real, pointer :: var3d_next(:,:,:) => null() @@ -3235,7 +3235,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) alpha = tinv1/tinv2 end if call ESMF_FieldGet(FIELD, dimCount=fieldRank,name=name,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call ESMF_TimeGet(item%interp_time1,yy=yr,mm=mm,dd=dd,h=hr,m=mn,s=sc,__RC__) call MAPL_PackTime(nhms1,hr,mn,sc) @@ -3253,7 +3253,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) nhms2=0 nymd2=0 end if - + if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) else if (time == item%interp_time1) then @@ -3364,7 +3364,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) end if enddo enddo - enddo + enddo endif _RETURN(ESMF_SUCCESS) @@ -3387,7 +3387,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) if (trim(item%importVDir)/=trim(item%fileVDir)) then call MAPL_ExtDataFlipVertical(item,filec,rc=status) _VERIFY(status) - end if + end if if (item%vartype == MAPL_fieldItem) then call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) _VERIFY(STATUS) @@ -3398,7 +3398,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) - + else if (item%vartype == MAPL_ExtDataVectorItem) then id_ps = ExtState%primaryOrder(1) @@ -3447,7 +3447,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) _VERIFY(status) end if end if - + _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataVerticalInterpolate @@ -3564,7 +3564,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if k=32 @@ -3579,7 +3579,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) deallocate(flag,stat=status) _VERIFY(STATUS) - ! Set local mask to 1 where gridMask matches each integer (within precision!) + ! Set local mask to 1 where gridMask matches each integer (within precision!) ! --------------------------------------------------------------------------- allocate(mask(size(rmask,1),size(rmask,2)),stat=status) _VERIFY(STATUS) @@ -3627,7 +3627,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then @@ -3741,7 +3741,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then @@ -3789,15 +3789,15 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc INTEGER, INTENT(IN) :: iSize INTEGER, INTENT(INOUT) :: iValues(iSize)! Space allocated for extracted integers CHARACTER(LEN=*), OPTIONAL :: delimiter ! 1-character delimiter - LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. - ! DEBUG directive turns on the message even - ! if verbose is not present or if + LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. + ! DEBUG directive turns on the message even + ! if verbose is not present or if ! verbose = .FALSE. INTEGER, OPTIONAL, INTENT(OUT) :: rc ! Return code -! !DESCRIPTION: +! !DESCRIPTION: ! ! Extract integers from a character-delimited string, for example, "-1,45,256,7,10". In the context -! of Chem_Util, this is provided for determining the numerically indexed regions over which an +! of Chem_Util, this is provided for determining the numerically indexed regions over which an ! emission might be applied. ! ! In multiple passes, the string is parsed for the delimiter, and the characters up to, but not @@ -3808,7 +3808,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc ! The default delimiter is a comma (","). ! ! "Unfilled" iValues are zero. -! +! ! Return codes: ! 1 Zero-length string. ! 2 iSize needs to be increased. @@ -3839,7 +3839,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc ! "+1" ! "1 3 6" ! -! !REVISION HISTORY: +! !REVISION HISTORY: ! ! Taken from chem utilities. ! @@ -3862,7 +3862,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc base = ICHAR("0") iDash = ICHAR("-") -! Determine verbosity, letting the DEBUG +! Determine verbosity, letting the DEBUG ! directive override local specification ! -------------------------------------- tellMe = .FALSE. @@ -4014,9 +4014,9 @@ subroutine AdvanceAndCount(CF,nLines,rc) _VERIFY(STATUS) call ESMF_ConfigGetAttribute(CF,thisLine,rc=status) _VERIFY(STATUS) - if (trim(thisLine) == "%%") then + if (trim(thisLine) == "%%") then inBlock = .false. - else + else iCnt = iCnt + 1 end if end do @@ -4026,7 +4026,7 @@ subroutine AdvanceAndCount(CF,nLines,rc) end subroutine advanceAndCount - subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedItem,rc) + subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedItem,rc) logical, intent(out ) :: doUpdate type(ESMF_Time), intent(inout) :: updateTime type(ESMF_Time), intent(inout) :: currTime @@ -4043,7 +4043,7 @@ subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedIt time0 = currTime time = currTime if (present(primaryItem)) then - + if (primaryItem%AlarmIsEnabled) then doUpdate = primaryItem%update_alarm%is_ringing(currTime,__RC__) if (hasRun .eqv. .false.) doUpdate = .true. @@ -4095,11 +4095,11 @@ subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedIt end if end if end if - + _RETURN(ESMF_SUCCESS) end subroutine CheckUpdate - subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) + subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) type(ESMF_Clock), intent(inout) :: Clock type(PrimaryExport), optional, intent(inout) :: primaryItem type(DerivedExport), optional, intent(inout) :: derivedItem @@ -4129,7 +4129,7 @@ subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) call MAPL_NCIOParseTimeUnits(ctInt,iyy,imm,idd,ihh,imn,isc,status) _VERIFY(STATUS) call ESMF_TimeIntervalSet(tInterval,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) - _VERIFY(STATUS) + _VERIFY(STATUS) if (present(primaryItem)) then primaryItem%update_alarm = simpleAlarm(current_time,tInterval,rc=status) _VERIFY(status) @@ -4245,7 +4245,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) character(len=ESMF_MAXSTR) :: Iam logical :: getRL_ - + Iam = "MAPL_ExtDataGetBracket" if (present(getRL)) then @@ -4258,7 +4258,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then - if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then + if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then if (getRL_) then field = item%modelGridFields%v1_faux1 _RETURN(ESMF_SUCCESS) @@ -4266,7 +4266,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v1_finterp1 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then if (getRL_) then field = item%modelGridFields%v2_faux1 _RETURN(ESMF_SUCCESS) @@ -4274,7 +4274,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v2_finterp1 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then if (getRL_) then field = item%modelGridFields%v1_faux2 _RETURN(ESMF_SUCCESS) @@ -4282,7 +4282,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v1_finterp2 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then if (getRL_) then field = item%modelGridFields%v2_faux2 _RETURN(ESMF_SUCCESS) @@ -4304,7 +4304,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (getRL_) then field = item%modelGridFields%v1_faux1 _RETURN(ESMF_SUCCESS) - else + else field = item%modelGridFields%v1_finterp1 _RETURN(ESMF_SUCCESS) end if @@ -4312,16 +4312,16 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (getRL_) then field = item%modelGridFields%v1_faux2 _RETURN(ESMF_SUCCESS) - else + else field = item%modelGridFields%v1_finterp2 _RETURN(ESMF_SUCCESS) end if end if else if (present(bundle)) then - if (Bside == MAPL_ExtDataLeft) then + if (Bside == MAPL_ExtDataLeft) then bundle = item%binterp1 _RETURN(ESMF_SUCCESS) - else if (Bside == MAPL_ExtDataRight) then + else if (Bside == MAPL_ExtDataRight) then bundle = item%binterp2 _RETURN(ESMF_SUCCESS) end if @@ -4379,16 +4379,16 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) end if _RETURN(ESMF_SUCCESS) - + end subroutine MAPL_ExtDataFillField subroutine MAPL_ExtDataFlipVertical(item,filec,rc) type(PrimaryExport), intent(inout) :: item integer, intent(in) :: filec integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 real, pointer :: ptr(:,:,:) real, allocatable :: ptemp(:,:,:) @@ -4445,9 +4445,9 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) integer, intent(in) :: filec type(ESMF_FieldBundle), intent(inout) :: pbundle integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid @@ -4507,7 +4507,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) type (IoBundleVectorIterator) :: bundle_iter type (ExtData_IoBundle), pointer :: io_bundle integer :: status - + bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() @@ -4610,7 +4610,7 @@ end subroutine createFileLevBracket subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,file,bside,time_index,rc) type(Iobundlevector), intent(inout) :: IOBundles - type(primaryExport), intent(in) :: item + type(primaryExport), intent(in) :: item integer, intent(in) :: entry_num character(len=*), intent(in) :: file integer, intent(in) :: bside diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4c4d0bf1aec2..c0ee19fbc800 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -541,7 +541,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) else if (trim(cFileOrder) == 'AddOrder') then intstate%fileOrderAlphabetical = .false. else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if call ESMF_ConfigGetAttribute(config, value=intstate%integer_time,label="IntegerTime:", default=.false.,_RC) @@ -1421,7 +1421,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) else if (index(list(n)%field_set%fields(1,m),'%') /= 0) then call WRITE_PARALLEL('Can not do arithmetic expression with bundle item') - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if enddo @@ -2579,7 +2579,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) case (3) print *, ' XY-offset: ',list(n)%xyoffset,' (DePe: Dateline Edge, Pole Edge)' case default - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end select !print *, ' Fields: ',((trim(list(n)%field_set%fields(3,m)),' '),m=1,list(n)%field_set%nfields) @@ -3009,7 +3009,7 @@ function hasSplitableField(fldName, rc) result(okToSplit) exp_state = export(k) call MAPL_StateGet(exp_state,baseName,fld,__RC__) - + okToSplit = hasSplitField(fld, __RC__) if (okToSplit) then @@ -5085,7 +5085,7 @@ subroutine MAPL_SetExpression(nfield,fields,tmpfields,rewrite,nPExtraFields, & if (ifound_vloc) then if (ivLoc /= Totloc(i) .and. totloc(i) /= MAPL_VLocationNone) then - _ASSERT(.false.,'arithmetic expression has two different vlocations') + _FAIL('arithmetic expression has two different vlocations') end if else if (totloc(i) /= MAPL_VLocationNone) then @@ -5381,7 +5381,7 @@ subroutine shavebits( state, list, rc) call pFIO_DownBit(ptr3d,ptr3d,list%nbits,undef=MAPL_undef,rc=status) _VERIFY(STATUS) else - _ASSERT(.false. ,'The field rank is not implmented') + _FAIL('The field rank is not implmented') endif enddo diff --git a/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 b/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 index 00812e736fd3..94e0d1c3d3a8 100644 --- a/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 +++ b/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 @@ -596,7 +596,7 @@ subroutine get_file_start_time(this,start_time,time_units,rc) endif endif class default - _ASSERT(.false.,"Time unit must be character") + _FAIL("Time unit must be character") end select call ESMF_TimeSet(start_time,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) _VERIFY(status) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index ea18ad2c1dba..84b5b63dfb0c 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -301,7 +301,7 @@ subroutine CreateVariable(this,itemName,rc) else if (fieldRank==3) then vdims=grid_dims//",lev,time" else - _ASSERT(.false., 'Unsupported field rank') + _FAIL( 'Unsupported field rank') end if v = Variable(type=PFIO_REAL32,dimensions=vdims,chunksizes=this%chunking,deflation=this%deflateLevel) call v%add_attribute('units',trim(units)) @@ -541,7 +541,7 @@ subroutine RegridScalar(this,itemName,rc) _VERIFY(status) end if else - _ASSERT(.false.,'rank not supported') + _FAIL('rank not supported') end if if (allocated(ptr3d_inter)) deallocate(ptr3d_inter) @@ -851,7 +851,7 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) allocate(globalStart,source=[gridGlobalStart,1,tindex]) allocate(globalCount,source=[gridGlobalCount,lm,1]) else - _ASSERT(.false., "Rank not supported") + _FAIL( "Rank not supported") end if call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) @@ -1104,7 +1104,7 @@ subroutine swap_undef_value(this,fname,rc) end if where(ptr3d==fill_value) ptr3d=MAPL_UNDEF else - _ASSERT(.false.,'rank not supported') + _FAIL('rank not supported') end if end if _RETURN(_SUCCESS) diff --git a/griddedio/Regrid_Util.F90 b/griddedio/Regrid_Util.F90 index f5affdc4d7d2..b23a7f008765 100644 --- a/griddedio/Regrid_Util.F90 +++ b/griddedio/Regrid_Util.F90 @@ -185,7 +185,7 @@ subroutine process_command_line(this,rc) if (trim(regridMth) .ne. 'bilinear' .and. trim(regridMth ) .ne. 'conservative' .and. trim(regridMth ) .ne. 'conservative2' .and. & trim(regridMth).ne.'patch') then if (MAPL_AM_I_Root()) write(*,*)'invalid regrid method choose bilinear or conservative' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if if (trim(regridMth) == 'bilinear') then this%regridMethod = REGRID_METHOD_BILINEAR diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index 6c5dacb8a597..cfb717379045 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -109,7 +109,7 @@ # define _ASSERT(A,msg) _ASSERT_MSG_AND_LOC(A,msg,1,_FILE_,__LINE__) # define _ASSERT_RC(A,msg,stat) _ASSERT_MSG_AND_LOC(A,msg,stat,_FILE_,__LINE__) # define _ASSERT_NOMSG(A) _ASSERT(A,'needs informative message') -# define _FAIL(msg) _ASSERT(.false.,msg) +# define _FAIL(msg) _FAIL(msg) # endif diff --git a/pfio/AbstractDataReference.F90 b/pfio/AbstractDataReference.F90 index bfe9704b1f34..2a31225eb722 100644 --- a/pfio/AbstractDataReference.F90 +++ b/pfio/AbstractDataReference.F90 @@ -140,7 +140,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) full_rank = size(global_shape) if(size(this%shape) > full_rank) then - _ASSERT(.false.,"ranks do not agree (probably fixable)") + _FAIL("ranks do not agree (probably fixable)") endif allocate(count(full_rank)) @@ -176,7 +176,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_0d) values_real64_0d=all_real64_0d case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case(1) s1=start(1) @@ -199,7 +199,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_1d, global_shape) values_real64_1d=all_real64_1d(s1:e1) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case(2) s1=start(1) @@ -224,7 +224,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_2d, global_shape) values_real64_2d=all_real64_2d(s1:e1,s2:e2) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (3) s1=start(1) @@ -251,7 +251,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_3d, global_shape) values_real64_3d=all_real64_3d(s1:e1,s2:e2,s3:e3) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (4) s1=start(1) @@ -280,7 +280,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_4d, global_shape) values_real64_4d=all_real64_4d(s1:e1,s2:e2,s3:e3,s4:e4) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (5) @@ -312,11 +312,11 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_5d, global_shape) values_real64_5d=all_real64_5d(s1:e1,s2:e2,s3:e3,s4:e4,s5:e5) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case default - _ASSERT(.false.,"dimension not supported yet") + _FAIL("dimension not supported yet") end select end subroutine fetch_data diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 3793a237309f..1224f5b0ffa6 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -315,20 +315,20 @@ subroutine receive_output_data(this, rc) class (AbstractServer),target, intent(inout) :: this integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of receive_output_data") + _FAIL(" no action of receive_output_data") end subroutine receive_output_data subroutine put_DataToFile(this, rc) class (AbstractServer),target, intent(inout) :: this integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of server_put_DataToFile") + _FAIL(" no action of server_put_DataToFile") end subroutine put_DataToFile subroutine get_DataFromMem(this,multi, rc) class (AbstractServer),target, intent(inout) :: this logical, intent(in) :: multi integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of server_get_DataFromMem") + _FAIL(" no action of server_get_DataFromMem") _UNUSED_DUMMY(multi) end subroutine get_DataFromMem diff --git a/pfio/ArrayReference.F90 b/pfio/ArrayReference.F90 index 716faaa5cd80..c821a7ee6d3b 100644 --- a/pfio/ArrayReference.F90 +++ b/pfio/ArrayReference.F90 @@ -55,7 +55,7 @@ function new_ArrayReference_0d(scalar, rc) result(reference) type is (integer(kind=INT64)) reference%base_address = c_loc(scalar) class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(scalar) reference%type_kind = type_kind(scalar) @@ -81,7 +81,7 @@ function new_ArrayReference_1d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -108,7 +108,7 @@ function new_ArrayReference_2d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -135,7 +135,7 @@ function new_ArrayReference_3d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -163,7 +163,7 @@ function new_ArrayReference_4d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -190,7 +190,7 @@ function new_ArrayReference_5d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -213,7 +213,7 @@ integer function type_kind(element, rc) type is (real(kind=REAL64)) type_kind = pFIO_REAL64 class default - _ASSERT(.false.,'kind error') + _FAIL('kind error') end select _RETURN(_SUCCESS) end function type_kind diff --git a/pfio/BaseServer.F90 b/pfio/BaseServer.F90 index 472df508f2f5..4ec1c741859b 100644 --- a/pfio/BaseServer.F90 +++ b/pfio/BaseServer.F90 @@ -125,7 +125,7 @@ subroutine put_DataToFile(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., "remote is a must") + _FAIL( "remote is a must") end select request_iter = this%stage_offset%find(i_to_string(q%request_id)//'done') @@ -219,7 +219,7 @@ function get_dmessage(this, rc) result(dmessage) type is (MpiSocket) allocate(dmessage,source = DummyMessage()) class default - _ASSERT(.false., "wrong socket type") + _FAIL( "wrong socket type") end select _RETURN(_SUCCESS) diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 1706c66c97ec..50adf0fff852 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -123,7 +123,7 @@ function add_ext_collection(this, template, rc) result(collection_id) type is(IDMessage) collection_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _RETURN(_SUCCESS) end function add_ext_collection @@ -146,7 +146,7 @@ function add_hist_collection(this, fmd, rc) result(hist_collection_id) type is(IDMessage) hist_collection_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _RETURN(_SUCCESS) @@ -172,7 +172,7 @@ subroutine replace_hist_collection(this,hist_collection_id,fmd, rc) type is(IDMessage) return_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _ASSERT( return_id == hist_collection_id, "return id should be the same as the collection_id") diff --git a/pfio/CoordinateVariable.F90 b/pfio/CoordinateVariable.F90 index e692e4a59f00..9ae8cade769a 100644 --- a/pfio/CoordinateVariable.F90 +++ b/pfio/CoordinateVariable.F90 @@ -119,7 +119,7 @@ subroutine get_real32(this, coordinate_data, unusable, rc) type is (real(kind=REAL32)) coordinate_data => q class default ! wrong type - _ASSERT(.false., "wrong type") + _FAIL( "wrong type") end select _RETURN(_SUCCESS) @@ -138,7 +138,7 @@ subroutine get_real64(this, coordinate_data, unusable, rc) type is (real(kind=REAL64)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -156,7 +156,7 @@ subroutine get_int32(this, coordinate_data, unusable, rc) type is (integer(kind=INT32)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -174,7 +174,7 @@ subroutine get_int64(this, coordinate_data, unusable, rc) type is (integer(kind=INT64)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -209,7 +209,7 @@ subroutine serialize(this, buffer, rc) type_kind = pFIO_REAL64 buffer =[tmp_buffer, serialize_intrinsic(type_kind),serialize_intrinsic(coord)] class default - _ASSERT(.false.,"not support coord type") + _FAIL("not support coord type") end select length = serialize_buffer_length(length)+ serialize_buffer_length(Coord_SERIALIZE_TYPE) + size(buffer) buffer = [serialize_intrinsic(length), serialize_intrinsic(Coord_SERIALIZE_TYPE), buffer] @@ -273,7 +273,7 @@ subroutine deserialize(this, buffer, rc) call deserialize_intrinsic(buffer(n:),values_REAL64) allocate(this%coordinate_data, source = values_real64) case default - _ASSERT(.false., "not supportted type") + _FAIL( "not supportted type") end select _RETURN(_SUCCESS) end subroutine deserialize diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index 7db3a79ab68c..8d68728e4c0d 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -160,7 +160,7 @@ integer function get_dimension(this, dim_name, unusable, rc) result(extent) else extent = 0 if (present(rc)) rc=pFIO_DIMENSION_NOT_FOUND - !_ASSERT(.false., 'FileMetadata::get_dimension() - no such dimension <'//dim_name//'>.') + !_FAIL( 'FileMetadata::get_dimension() - no such dimension <'//dim_name//'>.') end if _UNUSED_DUMMY(unusable) diff --git a/pfio/LocalMemReference.F90 b/pfio/LocalMemReference.F90 index 23d74414fa53..bae5ebfb3b0a 100644 --- a/pfio/LocalMemReference.F90 +++ b/pfio/LocalMemReference.F90 @@ -90,7 +90,7 @@ function new_LocalMemReference_0d(scalar, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr) real64Ptr = scalar class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -140,7 +140,7 @@ function new_LocalMemReference_1d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -191,7 +191,7 @@ function new_LocalMemReference_2d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -242,7 +242,7 @@ function new_LocalMemReference_3d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -293,7 +293,7 @@ function new_LocalMemReference_4d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -344,7 +344,7 @@ function new_LocalMemReference_5d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) diff --git a/pfio/MessageVisitor.F90 b/pfio/MessageVisitor.F90 index c1a1805545b2..e2134c940693 100644 --- a/pfio/MessageVisitor.F90 +++ b/pfio/MessageVisitor.F90 @@ -126,7 +126,7 @@ recursive subroutine handle(this, message, rc) ! if the serverthread sends the dummy directly to clientthread, it will not go through here. _VERIFY(0) class default - _ASSERT(.false., 'unsupported subclass') + _FAIL( 'unsupported subclass') end select _RETURN(_SUCCESS) end subroutine handle @@ -135,7 +135,7 @@ subroutine handle_CollectivePrefetchData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (CollectivePrefetchDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_CollectivePrefetchData should not be called") + _FAIL( "Warning : dummy handle_CollectivePrefetchData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_CollectivePrefetchData @@ -144,7 +144,7 @@ subroutine handle_CollectiveStageData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (CollectiveStageDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_CollectiveStageData should not be called") + _FAIL( "Warning : dummy handle_CollectiveStageData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_CollectiveStageData @@ -153,7 +153,7 @@ subroutine handle_Terminate(this, message, rc) class (MessageVisitor), intent(inout) :: this type (TerminateMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Terminate should not be called") + _FAIL( "Warning : dummy handle_Terminate should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Terminate @@ -162,7 +162,7 @@ subroutine handle_Done(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (DoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done should not be called") + _FAIL( "Warning : dummy handle_Done should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done @@ -171,7 +171,7 @@ subroutine handle_Done_prefetch(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (PrefetchDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_prefetch should not be called") + _FAIL( "Warning : dummy handle_Done_prefetch should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_prefetch @@ -180,7 +180,7 @@ subroutine handle_Done_collective_prefetch(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (CollectivePrefetchDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_collective_prefetch should not be called") + _FAIL( "Warning : dummy handle_Done_collective_prefetch should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_collective_prefetch @@ -189,7 +189,7 @@ subroutine handle_Done_stage(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (StageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_stage should not be called") + _FAIL( "Warning : dummy handle_Done_stage should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_stage @@ -198,7 +198,7 @@ subroutine handle_Done_collective_stage(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (CollectiveStageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_collective_stage should not be called") + _FAIL( "Warning : dummy handle_Done_collective_stage should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_collective_stage @@ -207,7 +207,7 @@ subroutine handle_AddExtCollection(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (AddExtCollectionMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_AddExtCollection should not be called") + _FAIL( "Warning : dummy handle_AddExtCollection should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_AddExtCollection @@ -216,7 +216,7 @@ subroutine handle_AddHistCollection(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (AddHistCollectionMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_AddHistCollection should not be called") + _FAIL( "Warning : dummy handle_AddHistCollection should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_AddHistCollection @@ -225,7 +225,7 @@ subroutine handle_Id(this, message, rc) class (MessageVisitor), intent(inout) :: this type (IdMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_ID should not be called. hint: maybe server and app are the same?") + _FAIL( "Warning : dummy handle_ID should not be called. hint: maybe server and app are the same?") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Id @@ -234,7 +234,7 @@ subroutine handle_PrefetchData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (PrefetchDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_PrefetchData should not be called") + _FAIL( "Warning : dummy handle_PrefetchData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_PrefetchData @@ -243,7 +243,7 @@ subroutine handle_StageData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (StageDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_StageData should not be called") + _FAIL( "Warning : dummy handle_StageData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_StageData @@ -252,7 +252,7 @@ subroutine handle_ModifyMetadata(this, message, rc) class (MessageVisitor), intent(inout) :: this type (ModifyMetadataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_ModifyMetadata should not be called") + _FAIL( "Warning : dummy handle_ModifyMetadata should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_ModifyMetadata @@ -261,7 +261,7 @@ subroutine handle_HandShake(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (HandShakeMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_HandShake should not be called") + _FAIL( "Warning : dummy handle_HandShake should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_HandShake diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index 5d1f2246e167..99cd49a4c034 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -482,7 +482,7 @@ subroutine clean_up(this, rc) type is (LocalMemReference) i_ptr =>dataRefPtr%i_ptr class default - _ASSERT(.false., "I expect localmemReference") + _FAIL( "I expect localmemReference") end select iter = this%stage_offset%find(i_to_string(q%request_id)//'done') @@ -497,7 +497,7 @@ subroutine clean_up(this, rc) call this%stage_offset%insert(i_to_string(q%request_id)//'done',0_MPI_ADDRESS_KIND) endif class default - _ASSERT(.false., "I expect CollectiveStageDataMessage") + _FAIL( "I expect CollectiveStageDataMessage") end select call msg_iter%next() enddo diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index ec7d9a4901e3..ec8ef6ab7b27 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -264,7 +264,7 @@ subroutine put_DataToFile(this, rc) class (MultiGroupServer),target, intent(inout) :: this integer, optional, intent(out) :: rc if (this%front_Comm == MPI_COMM_NULL) then - _ASSERT(.false. , "hey backend does not call this") + _FAIL("hey backend does not call this") else _RETURN(_SUCCESS) endif @@ -383,7 +383,7 @@ subroutine receive_output_data(this, rc) endif if (associated(ioserver_profiler)) call ioserver_profiler%stop("collection_"//i_to_string(q%collection_id)) class default - _ASSERT(.false., "yet to implemented") + _FAIL( "yet to implemented") end select call iter%next() end do ! iter @@ -684,7 +684,7 @@ subroutine start_back_writers(rc) q%start(1) = word_size(q%type_kind)*(q%start(1)-1)+1 select case (d_rank) case (0) - _ASSERT(.false., "scalar ?? ") + _FAIL( "scalar ?? ") case (1) call c_f_pointer(address, g_1d, shape=q%global_count) msize_word = product(q%count) diff --git a/pfio/MultiLayerServer.F90 b/pfio/MultiLayerServer.F90 index 6857e179029f..48a96b8be76f 100644 --- a/pfio/MultiLayerServer.F90 +++ b/pfio/MultiLayerServer.F90 @@ -180,7 +180,7 @@ subroutine put_DataToFile(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., "remote is a must") + _FAIL( "remote is a must") end select request_iter = this%stage_offset%find(i_to_string(q%request_id)//'done') diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index ffadf77f9d53..382921e4b9c3 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -234,7 +234,7 @@ subroutine open(this, file, mode, unusable, comm, info, rc) case (pFIO_WRITE) omode = NF90_WRITE case default - _ASSERT(.false.,"read or write mode") + _FAIL("read or write mode") end select if (present(comm)) then diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index 832394bf368c..ca33c9f8a877 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -255,19 +255,19 @@ recursive subroutine handle_Done(this, message, rc) select type (q=>msg) type is (PrefetchDataMessage) - _ASSERT(.false., "please use done_prefetch") + _FAIL( "please use done_prefetch") _RETURN(_SUCCESS) type is (CollectivePrefetchDataMessage) - _ASSERT(.false., "please use done_collective_prefetch") + _FAIL( "please use done_collective_prefetch") _RETURN(_SUCCESS) type is (StageDataMessage) - _ASSERT(.false., "please use done_stage") + _FAIL( "please use done_stage") _RETURN(_SUCCESS) type is (CollectiveStageDataMessage) - _ASSERT(.false., "please use done_collective_stage") + _FAIL( "please use done_collective_stage") _RETURN(_SUCCESS) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select @@ -681,7 +681,7 @@ subroutine get_DataFromFile(this,message,address, rc) start = message%global_start count = message%global_count class default - _ASSERT(.false., "wrong PrefetchDataMessage type") + _FAIL( "wrong PrefetchDataMessage type") end select ! if (product(count) /= product(file_data_reference%shape)) stop "memory size not match" @@ -701,7 +701,7 @@ subroutine get_DataFromFile(this,message,address, rc) call c_f_pointer(address, values_real64_0d) call formatter%get_var(message%var_name, values_real64_0d, _RC) case default - _ASSERT(.false., "Not supported type") + _FAIL( "Not supported type") end select case (1:) select case (message%type_kind) @@ -718,7 +718,7 @@ subroutine get_DataFromFile(this,message,address, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%get_var(message%var_name, values_real64_1d, start=start, count=count, _RC) case default - _ASSERT(.false., "Not supported type") + _FAIL( "Not supported type") end select end select @@ -808,7 +808,7 @@ subroutine put_DataToFile(this, message, address, rc) count = message%global_count class default - _ASSERT(.false., "wrong StageDataMessage type") + _FAIL( "wrong StageDataMessage type") end select ! if (product(count) /= product(file_data_reference%shape)) stop "memory size not match" select case (size(count)) ! rank @@ -827,7 +827,7 @@ subroutine put_DataToFile(this, message, address, rc) call c_f_pointer(address, values_real64_0d) call formatter%put_var(message%var_name, values_real64_0d, _RC) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select case (1:) select case (message%type_kind) @@ -844,7 +844,7 @@ subroutine put_DataToFile(this, message, address, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%put_var(message%var_name, values_real64_1d, start=start, count=count, _RC) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select end select @@ -904,7 +904,7 @@ subroutine receive_output_data(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., " need a remote pointer") + _FAIL( " need a remote pointer") end select rank = remotePtr%mem_rank @@ -916,7 +916,7 @@ subroutine receive_output_data(this, rc) endif ! local_size > 0 class default - _ASSERT(.false., "receive_output_data") + _FAIL( "receive_output_data") end select call iter%next() enddo @@ -1028,7 +1028,7 @@ recursive subroutine handle_Done_stage(this, message, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select iter = this%request_backlog%begin() enddo @@ -1067,7 +1067,7 @@ recursive subroutine handle_Done_prefetch(this, message, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select iter = this%request_backlog%begin() enddo @@ -1164,7 +1164,7 @@ subroutine get_DataFromMem( this, multi_data_read, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Message type should be CollectivePrefetchDataMessage ") + _FAIL( "Message type should be CollectivePrefetchDataMessage ") end select iter = this%request_backlog%begin() enddo diff --git a/pfio/SimpleSocket.F90 b/pfio/SimpleSocket.F90 index 195ae6655914..65344ab9d9d9 100644 --- a/pfio/SimpleSocket.F90 +++ b/pfio/SimpleSocket.F90 @@ -106,7 +106,7 @@ recursive subroutine send(this, message, rc) allocate(connection%msg , source = message) call connection%msg%dispatch(this%visitor, _RC) class default - _ASSERT(.false.,"Simple should connect Simple") + _FAIL("Simple should connect Simple") end select _RETURN(_SUCCESS) ! call message%dispatch(this%visitor,_RC) diff --git a/pfio/UnlimitedEntity.F90 b/pfio/UnlimitedEntity.F90 index 4b21aa8a1b72..a8f3c706c27e 100644 --- a/pfio/UnlimitedEntity.F90 +++ b/pfio/UnlimitedEntity.F90 @@ -110,7 +110,7 @@ function new_UnlimitedEntity_1d(values, rc) result(attr) select type (values) type is (character(len=*)) - _ASSERT(.false., 'unsupported unless shape is [1]') + _FAIL( 'unsupported unless shape is [1]') class default allocate(attr%values, source=values) attr%shape = shape(values) @@ -137,7 +137,7 @@ function new_UnlimitedEntity_2d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -165,7 +165,7 @@ function new_UnlimitedEntity_3d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -193,7 +193,7 @@ function new_UnlimitedEntity_4d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -221,7 +221,7 @@ function new_UnlimitedEntity_5d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -544,7 +544,7 @@ subroutine serialize( this, buffer, rc) serialize_intrinsic(type_kind), & serialize_intrinsic(value%value)] class default - _ASSERT(.false.," type is not supported") + _FAIL(" type is not supported") end select endif case (1:) @@ -581,7 +581,7 @@ subroutine serialize( this, buffer, rc) ! serialize_intrinsic(type_kind), & ! serialize_intrinsic(values)] class default - _ASSERT(.false.," type is not supported") + _FAIL(" type is not supported") end select end select length = serialize_buffer_length(length) + size(buffer) @@ -658,7 +658,7 @@ subroutine deserialize( this, buffer, rc) ! this is uninitialized case, make sure shape is not allocated even it is empty if (allocated(this%shape))deallocate(this%shape) case default - _ASSERT(.false., "UnlimitedEntity deserialize not support") + _FAIL( "UnlimitedEntity deserialize not support") end select case (1:) select case (type_kind) @@ -678,7 +678,7 @@ subroutine deserialize( this, buffer, rc) call deserialize_intrinsic(buffer(n:),values_logical) allocate(this%values, source =values_logical) case default - _ASSERT(.false., "UnlimitedEntity deserialize not support") + _FAIL( "UnlimitedEntity deserialize not support") end select end select diff --git a/pfio/pFIO_Utilities.F90 b/pfio/pFIO_Utilities.F90 index d9152252321c..e94d903b831e 100644 --- a/pfio/pFIO_Utilities.F90 +++ b/pfio/pFIO_Utilities.F90 @@ -514,7 +514,7 @@ integer function word_size(type_kind,rc) case (pFIO_INT64) word_size = c_sizeof(i64)/c_sizeof(i32) case default - _ASSERT(.false., "unsupported type kind") + _FAIL( "unsupported type kind") end select _RETURN(_SUCCESS) diff --git a/pfio/pfio_writer.F90 b/pfio/pfio_writer.F90 index 3e3410749e2f..d567be3afb02 100644 --- a/pfio/pfio_writer.F90 +++ b/pfio/pfio_writer.F90 @@ -232,7 +232,7 @@ subroutine write_data(message, formatter, attr, rc) call c_f_pointer(address, values_real64_0d) call formatter%put_var(message%var_name, values_real64_0d) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select case (1:) select case (message%type_kind) @@ -249,7 +249,7 @@ subroutine write_data(message, formatter, attr, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%put_var(message%var_name, values_real64_1d, start=start, count=count) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select end select end subroutine diff --git a/shared/MAPL_HeapMod.F90 b/shared/MAPL_HeapMod.F90 index 4259394d93ae..ffab5917c1aa 100644 --- a/shared/MAPL_HeapMod.F90 +++ b/shared/MAPL_HeapMod.F90 @@ -139,7 +139,7 @@ end function loadr2d if(I>=NumSegments) then print *, 'MAPL_Alloc: Out of Segments. Need: ', I - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! If we are filling a gap, move trailing segments down @@ -174,7 +174,7 @@ end function loadr2d do i=1,NumSegments print *, i, heap%HP_start(i), heap%HP_end(i) end do - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if heap%ptrs(i)%a => heap%buffer(heap%HP_start(i):heap%HP_end(i)) @@ -216,7 +216,7 @@ end function ival1 i = i+1 if(i==NumSegments) then print *, 'MAPL_DeAlloc: Bad Pointer' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end do @@ -230,7 +230,7 @@ end function ival1 i = i+1 if(i==NumSegments-1) then print *, 'MAPL_DeAlloc: Something wrong. Missed bottom mark' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end do diff --git a/shared/Shmem/Shmem_implementation.F90 b/shared/Shmem/Shmem_implementation.F90 index 4de51b02915e..0c1c60851f9f 100644 --- a/shared/Shmem/Shmem_implementation.F90 +++ b/shared/Shmem/Shmem_implementation.F90 @@ -929,7 +929,7 @@ Segs(pos)%shmid = shmget(key, numBytes, shmflg) if (Segs(pos)%shmid < 0) then call perror('server shmget():'//C_NULL_CHAR) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if call MPI_Barrier(MAPL_NodeComm, STATUS) _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') From 1477f23d5dd917c3ff7851f5db2ef45a501eb5b2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 2 May 2022 11:09:46 -0400 Subject: [PATCH 2/2] Undo sed on the main command --- include/MAPL_ErrLog.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index cfb717379045..6c5dacb8a597 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -109,7 +109,7 @@ # define _ASSERT(A,msg) _ASSERT_MSG_AND_LOC(A,msg,1,_FILE_,__LINE__) # define _ASSERT_RC(A,msg,stat) _ASSERT_MSG_AND_LOC(A,msg,stat,_FILE_,__LINE__) # define _ASSERT_NOMSG(A) _ASSERT(A,'needs informative message') -# define _FAIL(msg) _FAIL(msg) +# define _FAIL(msg) _ASSERT(.false.,msg) # endif