diff --git a/.github/workflows/changelog-enforcer.yml b/.github/workflows/changelog-enforcer.yml index 6c00c9be769a..21ee03a2dacb 100644 --- a/.github/workflows/changelog-enforcer.yml +++ b/.github/workflows/changelog-enforcer.yml @@ -12,7 +12,7 @@ jobs: - uses: dangoslen/changelog-enforcer@v2 with: changeLogPath: 'CHANGELOG.md' - skipLabels: 'Skip Changelog,0 diff trivial' + skipLabels: 'Skip Changelog,0 diff trivial,automatic' missingUpdateErrorMessage: > No update to CHANGELOG.md found! Please add a changelog entry to it describing your change. Please note that the diff --git a/.github/workflows/push-to-develop.yml b/.github/workflows/push-to-develop.yml index a5decce22804..59424134bea2 100644 --- a/.github/workflows/push-to-develop.yml +++ b/.github/workflows/push-to-develop.yml @@ -20,7 +20,7 @@ jobs: github_token: ${{ secrets.GITHUB_TOKEN }} source_branch: develop target_branch: release/MAPL-v3 - label: automatic,MAPL3 + label: automatic,MAPL3,Skip Changelog template: .github/PULL_REQUEST_TEMPLATE/auto_pr_to_mapl3.md get_diff: true assignee: ${{ github.actor }} diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index df880a119c2e..b65e51d3a808 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -3,7 +3,6 @@ import sys import os import csv -import pandas as pd ############################################################### @@ -183,6 +182,13 @@ def csv_record_reader(csv_reader): elif not prev_row_blank: return + def dataframe(reader, columns): + """ Read a reader iterator and return a list of dictionaries, each including column name and value. """ + df = [] + for row in reader: + df.append(dict(zip(columns, row))) + return df + column_aliases = { 'NAME' : 'short_name', 'LONG NAME' : 'long_name', @@ -217,7 +223,7 @@ def csv_record_reader(csv_reader): columns.append(column_aliases[c]) else: columns.append(c) - specs[category] = pd.DataFrame(gen, columns=columns) + specs[category] = dataframe(gen, columns) except StopIteration: break @@ -310,7 +316,7 @@ def open_with_header(filename): # Generate code from specs (processed above with pandas) for category in ("IMPORT","EXPORT","INTERNAL"): - for item in specs[category].to_dict("records"): + for item in specs[category]: spec = MAPL_DataSpec(category.lower(), item) if f_specs[category]: f_specs[category].write(spec.emit_specs()) diff --git a/CHANGELOG.md b/CHANGELOG.md index e3d28f25195c..1652b6c9920f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,12 +7,40 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +### Removed + +### Added + +### Changed + +### Fixed + +## [2.8.3] - 2021-08-19 ### Removed + +- Removed Pandas dependency +- Removed unused functions from NominalOrbits Module + ### Added + +- Added error message to pFIO_NetCDF4_FileFormatterMod if nf90_open() fails. +- Add option to flip native level output in History relative to input +- Added `MAPL_AllocNodeArray_6DR8` and `MAPL_DeAllocNodeArray_6DR8` to Shmem +- Refactors Constants into its own library and consolidated mathematical/physical constants used throughout code to use those from library +- Added single precision Degrees to Radian Conversion + ### Changed + +- Simplified implementation of MAPL_FieldCopyAttributes +- Updated `components.yaml` + - ESMA_cmake v3.5.3 + ### Fixed +- Added npes for pfio_MAPL_demo.F90 when --npes_model is not specified in command line +- Fixed bug in ExtData when doing vector pairs + ## [2.8.2] - 2021-07-29 ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index be93ce7d6a70..4478065ac983 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.8.2 + VERSION 2.8.3 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # mepo can now clone subrepos in three styles diff --git a/MAPL_cfio/ESMF_CFIOUtilMod.F90 b/MAPL_cfio/ESMF_CFIOUtilMod.F90 index 7897f4163a4a..bfa1a9ec5e05 100644 --- a/MAPL_cfio/ESMF_CFIOUtilMod.F90 +++ b/MAPL_cfio/ESMF_CFIOUtilMod.F90 @@ -43,8 +43,6 @@ module ESMF_CFIOUtilMod integer, parameter :: NDIMS_MAX = 4 integer, parameter :: MAX_VAR_DIMS = 32 character*7, parameter :: GRID_NAME='EOSGRID' - integer, parameter :: NFILES_MAX = 64 - integer, parameter :: NVARS_MAX = 128 integer, parameter :: MAXCHR = 256 integer, parameter :: PACK_BITS = 32766 integer, parameter :: PACK_FILL = 32767 diff --git a/Python/MAPL/constants.py b/Python/MAPL/constants.py index 89a815ac0e55..faeb9580a4e7 100644 --- a/Python/MAPL/constants.py +++ b/Python/MAPL/constants.py @@ -6,41 +6,32 @@ MAPL_DEGREES_TO_RADIANS = MAPL_PI / 180.0 MAPL_RADIANS_TO_DEGREES = 180.0 / MAPL_PI -MAPL_UNDEF = 1.0e15 - -MAPL_PSDRY = 98305.0 +MAPL_PSDRY = 98305.0 # dry surface pressure [Pa] +MAPL_SECONDS_PER_SIDEREAL_DAY = 86164.0 #s MAPL_GRAV = 9.80665 # m^2/s MAPL_RADIUS = 6371.0E3 # m -MAPL_OMEGA = 2.0*MAPL_PI/86164.0 # 1/s -MAPL_STFBOL = 5.6734E-8 # W/(m^2 K^4) -MAPL_AIRMW = 28.965 # kg/Kmole -MAPL_H2OMW = 18.015 # kg/Kmole -MAPL_O3MW = 47.9982 # kg/Kmole -MAPL_RUNIV = 8314.47 # J/(Kmole K) -MAPL_ALHL = 2.4665E6 # J/kg @15C -MAPL_ALHF = 3.3370E5 # J/kg -MAPL_ALHS = MAPL_ALHL+MAPL_ALHF # J/kg +MAPL_OMEGA = 2.0*MAPL_PI/MAPL_SECONDS_PER_SIDEREAL_DAY # 1/s +MAPL_EARTH_ECCENTRICITY = 8.1819190842622E-2 # -- +MAPL_EARTH_SEMIMAJOR_AXIS = 6378137 # m +MAPL_KM_PER_DEG = (1.0/(MAPL_RADIUS/1000.)) * MAPL_RADIANS_TO_DEGREES +MAPL_DEG_PER_KM = (MAPL_RADIUS/1000.) * MAPL_DEGREES_TO_RADIANS +MAPL_AIRMW = 28.965 # kg/Kmole MAPL_RDRY = MAPL_RUNIV/MAPL_AIRMW # J/(kg K) MAPL_CPDRY = 3.5*MAPL_RDRY # J/(kg K) MAPL_CVDRY = MAPL_CPDRY-MAPL_RDRY # J/(kg K) - MAPL_RVAP = MAPL_RUNIV/MAPL_H2OMW # J/(kg K) MAPL_CPVAP = 4.*MAPL_RVAP # J/(kg K) MAPL_CVVAP = MAPL_CPVAP-MAPL_RVAP # J/(kg K) - MAPL_KAPPA = MAPL_RDRY/MAPL_CPDRY # (2.0/7.0) - MAPL_EPSILON = MAPL_H2OMW/MAPL_AIRMW # -- MAPL_DELTAP = MAPL_CPVAP/MAPL_CPDRY # -- MAPL_DELTAV = MAPL_CVVAP/MAPL_CVDRY # -- MAPL_GAMMAD = MAPL_CPDRY/MAPL_CVDRY # -- - MAPL_RGAS = MAPL_RDRY # J/(kg K) (DEPRECATED) MAPL_CP = MAPL_RGAS/MAPL_KAPPA # J/(kg K) (DEPRECATED) MAPL_VIREPS = 1.0/MAPL_EPSILON-1.0 # (DEPRECATED) - MAPL_P00 = 100000.0 # Pa MAPL_CAPICE = 2000. # J/(K kg) MAPL_CAPWTR = 4218. # J/(K kg) @@ -50,9 +41,126 @@ MAPL_SRFPRS = 98470 # Pa MAPL_KARMAN = 0.40 # -- MAPL_USMIN = 1.00 # m/s -MAPL_AVOGAD = 6.023E26 # 1/kmol - MAPL_RHO_SEAWATER = 1026.0 # sea water density [kg/m^3]. SA: should it be = 1026 kg/m^3? MAPL_RHO_SEAICE = 917.0 # sea ice density [kg/m^3]. SA: should it be = 917 kg/m^3? MAPL_RHO_SNOW = 330.0 # snow density [kg/m^3]. SA: should it be = 330 kg/m^3? +MAPL_CELSIUS_TO_KELVIN = 273.15 # K + +MAPL_STFBOL = 5.6734E-8 # W/(m^2 K^4) +MAPL_AVOGAD = 6.023E26 # 1/kmol +MAPL_RUNIV = 8314.47 # J/(Kmole K) + +MAPL_H2OMW = 18.015 # kg/Kmole +MAPL_O3MW = 47.9982 # kg/Kmole +MAPL_ALHL = 2.4665E6 # J/kg @15C +MAPL_ALHF = 3.3370E5 # J/kg +MAPL_ALHS = MAPL_ALHL+MAPL_ALHF # J/kg + + +#Internal constants +MAPL_GRID_NAME_DEFAULT = 'UNKNOWN' +MAPL_GRID_FILE_NAME_DEFAULT = 'UNKNOWN' +MAPL_CF_COMPONENT_SEPARATOR = '.' + +MAPL_TimerModeOld = 0 +MAPL_TimerModeRootOnly = 1 +MAPL_TimerModeMax = 2 +MAPL_TimerModeMinMax = 3 + +MAPL_UseStarrQsat = 1 +MAPL_UseGoffGratchQsat = 2 +MAPL_UseMurphyKoopQsat =3 +MAPL_UseCAMQsat =4 + +MAPL_Unknown = 0 +MAPL_IsGather = 1 +MAPL_IsScatter = 2 + +MAPL_TileNameLength = 128 + +MAPL_NoShm = 255 + +MAPL_SUCCESS = 0 +MAPL_FILE_NOT_FOUND = 1 + +MAPL_DimTopoEdge = -1 +MAPL_DimTopoCyclic = 0 +MAPL_DimTopoCenter = 1 + +MAPL_CplUNKNOWN = 0 +MAPL_CplSATISFIED = 1 +MAPL_CplNEEDED = 2 +MAPL_Cpl_NOTNEEDED = 4 +MAPL_FriendlyVariable = 8 +MAPL_FieldItem = 8 +MAPL_BundleItem = 16 +MAPL_StateItem = 32 +MAPL_NoRestart = 64 + +MAPL_Write2Disk = 0 +MAPL_Write2RAM = 1 + +MAPL_VLocationNone = 0 +MAPL_VLocationEdge = 1 +MAPL_VLocationCenter = 2 + +MAPL_DimsUnknown = 0 +MAPL_DimsVertOnly = 1 +MAPL_DimsHorzOnly = 2 +MAPL_DimsHorzVert = 3 +MAPL_DimsTileOnly = 4 +MAPL_DimsTileTile = 5 +MAPL_DimsNone = 6 + +MAPL_ScalarField = 1 +MAPL_VectorField = 2 + +MAPL_CplAverage = 0 +MAPL_CplMin = 1 +MAPL_CplMax = 2 +MAPL_CplAccumulate = 3 +MAPL_MinMaxUnknown = 4 + +MAPL_AttrGrid = 1 +MAPl_AttrTile = 2 + +MAPL_Uninitialized = 0 +MAPL_InitialDefault = 1 +MAPL_InitialRestart = 2 + +MAPL_DuplicateEntry = -99 +MAPL_ConnUnknown = -1 +MAPL_Self = 0 +MAPL_Import = 1 +MAPL_Export = 2 + +MAPL_FirstPhase = 1 +MAPL_SecondPhase = MAPL_FirstPhase + 1 +MAPL_ThirdPhase = MAPL_SecondPhase + 1 +MAPL_FourthPhase = MAPL_ThirdPhase + 1 +MAPL_FifthPhase = MAPL_FourthPhase + 1 + +MAPL_Ocean = 0 +MAPL_Lake = 19 +MAPL_LandIce = 20 +MAPL_Land = 100 +MAPL_Vegetated = 101 +MAPL_NumVegTypes = 6 + +MAPL_AGrid = 0 +MAPL_CGrid = 1 +MAPL_DGrid = 2 + +MAPL_RotateLL = 0 +MAPL_RotateCube = 1 + +MAPL_HorzTransOrderBinning = 0 +MAPL_HorzTransOrderBilinear = 1 +MAPL_HorzTransOrderFraction = 98 +MAPL_HorzTransOrderSample = 99 +MAPL_RestartOptional = 0 +MAPL_RestartSkip = 1 +MAPL_RestartRequired = 2 +MAPL_Restart_Bootstrap = 3 +MAPL_RestartSkipInitial = 4 diff --git a/Tests/pfio_MAPL_demo.F90 b/Tests/pfio_MAPL_demo.F90 index 8ede6afb7bdd..61225da34dee 100755 --- a/Tests/pfio_MAPL_demo.F90 +++ b/Tests/pfio_MAPL_demo.F90 @@ -79,7 +79,12 @@ program main cap_options = MAPL_CapOptions(cli) call MPI_init(ierror) - + + call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) + if ( cap_options%npes_model == -1) then + cap_options%npes_model = npes + endif + ! Initialize the IO Server Manager using parameters defined above call ioserver_manager%initialize(MPI_COMM_WORLD, & application_size = cap_options%npes_model, & diff --git a/base/Base/Base.F90 b/base/Base/Base.F90 index fe10062c64ac..efe11622bc26 100644 --- a/base/Base/Base.F90 +++ b/base/Base/Base.F90 @@ -67,7 +67,6 @@ module MAPL_Base real, public, parameter :: MAPL_UNDEF = 1.0e15 - integer, public, parameter :: MAPL_TileNameLength = 128 character(len=ESMF_MAXSTR), public, parameter :: MAPL_StateItemOrderList = 'MAPL_StateItemOrderList' character(len=ESMF_MAXSTR), public, parameter :: MAPL_BundleItemOrderList = 'MAPL_BundleItemOrderList' @@ -807,7 +806,7 @@ module MAPL_BaseMod use MAPL_Base use MAPL_RangeMod, only: MAPL_Range use MaplGeneric, only: MAPL_GridGet, MAPL_DistGridGet, MAPL_GetImsJms, MAPL_GridHasDE - use Mapl_Enumerators + use MAPL_Constants diff --git a/base/Base/Base_implementation.F90 b/base/Base/Base_implementation.F90 index 571305c73e53..b4b49bb9a978 100644 --- a/base/Base/Base_implementation.F90 +++ b/base/Base/Base_implementation.F90 @@ -10,11 +10,10 @@ ! !USES: ! use ESMF - use MAPL_ConstantsMod, only: MAPL_PI, MAPL_PI_R8,MAPL_DEGREES_TO_RADIANS + use MAPL_Constants use MAPL_RangeMod use MAPL_SphericalGeometry use MaplGeneric, only: MAPL_GridGet, MAPL_DistGridGet, MAPL_GetImsJms, MAPL_GridHasDE - use mapl_Enumerators use MAPL_ExceptionHandling implicit NONE @@ -1057,10 +1056,9 @@ end subroutine MAPL_tick integer module function MAPL_nsecf2 (nhhmmss,nmmdd,nymd) integer nhhmmss,nmmdd,nymd,nday,month - integer nsday, ncycle,iday,iday2 + integer nsday,iday,iday2 integer i,nsegm,nsegd PARAMETER ( NSDAY = 86400 ) - PARAMETER ( NCYCLE = 1461*24*3600 ) INTEGER YEAR, DAY, SEC integer MNDY(12,4), mnd48(48) DATA MND48/0,31,60,91,121,152,182,213,244,274,305,335,366,397,34*0 / @@ -1698,62 +1696,10 @@ module subroutine MAPL_FieldCopyAttributes(FIELD_IN, FIELD_OUT, RC) type (ESMF_Field), intent(INOUT) :: FIELD_IN !ALT: intent(in) type (ESMF_Field), intent(INOUT) :: FIELD_OUT integer, optional, intent( OUT) :: RC - - type (ESMF_TypeKind_Flag) :: tk integer :: status - character(len=ESMF_MAXSTR), parameter :: Iam='MAPL_FieldCopyAttributes' - integer :: i, n, count - character(len=ESMF_MAXSTR) :: attname - character(len=ESMF_MAXSTR) :: att - integer, pointer :: iptr(:) - logical, pointer :: lptr(:) - real, pointer :: rptr(:) - - call ESMF_AttributeGet(field_in, count=n, rc=status) - _VERIFY(STATUS) - - do i = 1, n - call ESMF_AttributeGet(field_in, attributeIndex=i, name=attname, & - typekind=tk, itemcount=count, rc=status) - _VERIFY(STATUS) - - if (tk == ESMF_TypeKind_I4) then - allocate(iptr(count), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(field_in, NAME=attname, itemcount=count, VALUELIST=iptr, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(field_out, NAME=attname, itemcount=count, VALUELIST=iptr, RC=STATUS) - _VERIFY(STATUS) - deallocate(iptr) - - else if (tk == ESMF_TypeKind_Logical) then - allocate(lptr(count), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(field_in, NAME=attname, itemcount=count, VALUELIST=lptr, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(field_out, NAME=attname, itemcount=count, VALUELIST=lptr, RC=STATUS) - _VERIFY(STATUS) - deallocate(lptr) - - else if (tk == ESMF_TypeKind_R4) then - allocate(rptr(count), stat=status) - _VERIFY(STATUS) - call ESMF_AttributeGet(field_in, NAME=attname, itemcount=count, VALUELIST=rptr, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(field_out, NAME=attname, itemcount=count, VALUELIST=rptr, RC=STATUS) - _VERIFY(STATUS) - deallocate(rptr) - - else if (tk == ESMF_TypeKind_Character) then - call ESMF_AttributeGet(field_in, NAME=attname, VALUE=att, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(field_out, NAME=attname, VALUE=att, RC=STATUS) - _VERIFY(STATUS) - - else - _RETURN(ESMF_FAILURE) - end if - end do + + call ESMF_AttributeCopy(field_in, field_out, attcopy=ESMF_ATTCOPY_VALUE, rc=status) + _VERIFY(status) _RETURN(ESMF_SUCCESS) end subroutine MAPL_FieldCopyAttributes @@ -2074,7 +2020,6 @@ module function MAPL_LatLonGridCreate (Name, vm, & real(ESMF_KIND_R8), allocatable :: cornerX(:) real(ESMF_KIND_R8), allocatable :: cornerY(:) - real(kind=REAL64), parameter :: D2R = MAPL_PI_R8 / 180 real :: FirstOut(2) real :: LastOut(2) @@ -2261,10 +2206,10 @@ module function MAPL_LatLonGridCreate (Name, vm, & ! Compute the coordinates (the corner/center is for backward compatibility) ! ------------------------------------------------------------------------- - deltaX = D2R * DelLon_ - deltaY = D2R * DelLat_ - minCoord(1) = D2R * BegLon_ - deltaX/2 - minCoord(2) = D2R * BegLat_ - deltaY/2 + deltaX = MAPL_DEGREES_TO_RADIANS_R8 * DelLon_ + deltaY = MAPL_DEGREES_TO_RADIANS_R8 * DelLat_ + minCoord(1) = MAPL_DEGREES_TO_RADIANS_R8 * BegLon_ - deltaX/2 + minCoord(2) = MAPL_DEGREES_TO_RADIANS_R8 * BegLat_ - deltaY/2 allocate(cornerX(IM_World_+1),cornerY(JM_World_+1), stat=STATUS) _VERIFY(STATUS) @@ -2297,14 +2242,14 @@ module function MAPL_LatLonGridCreate (Name, vm, & LastOut(2)=90. block - use MAPL_ConstantsMod, only: MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only: MAPL_DEGREES_TO_RADIANS_R8 real(kind=REAL64), allocatable :: lons(:) real(kind=REAL64), allocatable :: lats(:) lons = MAPL_Range(FirstOut(1), LastOut(1), im_world_, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8) lats = MAPL_Range(FirstOut(2), LastOut(2), JM_WORLD, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8) call MAPL_GRID_INTERIOR(grid, i1, in, j1, jn) @@ -2449,8 +2394,8 @@ module subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) call ESMF_GridGet(grid,coordSys=coordSys,rc=status) _VERIFY(status) if (coordSys==ESMF_COORDSYS_SPH_DEG) then - gridCornerLons=gridCornerLons*MAPL_DEGREES_TO_RADIANS - gridCornerLats=gridCornerLats*MAPL_DEGREES_TO_RADIANS + gridCornerLons=gridCornerLons*MAPL_DEGREES_TO_RADIANS_R8 + gridCornerLats=gridCornerLats*MAPL_DEGREES_TO_RADIANS_R8 else if (coordSys==ESMF_COORDSYS_CART) then _FAIL('Unsupported coordinate system: ESMF_COORDSYS_CART') end if @@ -3119,8 +3064,8 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) allocate(center_lons(im,jm),center_lats(im,jm)) if (coordSys==ESMF_COORDSYS_SPH_DEG) then - center_lons=lons*MAPL_DEGREES_TO_RADIANS - center_lats=lats*MAPL_DEGREES_TO_RADIANS + center_lons=lons*MAPL_DEGREES_TO_RADIANS_R8 + center_lats=lats*MAPL_DEGREES_TO_RADIANS_R8 else if (coordSys==ESMF_COORDSYS_SPH_RAD) then center_lons=lons center_lats=lats diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index df1b2a48c4bc..99bfd304e7c3 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -59,7 +59,7 @@ endif() esma_add_library( ${this} SRCS ${srcs} - DEPENDENCIES MAPL.generic MAPL.shared MAPL.profiler MAPL.pfio MAPL_cfio_r4 PFLOGGER::pflogger GFTL_SHARED::gftl-shared + DEPENDENCIES MAPL.generic MAPL.shared MAPL.constants MAPL.profiler MAPL.pfio MAPL_cfio_r4 PFLOGGER::pflogger GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) diff --git a/base/ESMFL_Mod.F90 b/base/ESMFL_Mod.F90 index ccd098aadb97..df52d0657637 100644 --- a/base/ESMFL_Mod.F90 +++ b/base/ESMFL_Mod.F90 @@ -19,7 +19,7 @@ module ESMFL_MOD !USES: use ESMF - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_BaseMod use MAPL_CommsMod use MAPL_ExceptionHandling @@ -1173,7 +1173,6 @@ subroutine ESMFL_RegridStore (srcFLD, SRCgrid2D, dstFLD, DSTgrid2D, & type(ESMF_Grid) :: grid3D real(kind=REAL32), pointer :: Sptr2d(:,:) real(kind=REAL32), pointer :: Dptr2d(:,:) - real :: pi real(ESMF_KIND_R8) :: deltaX, deltaY real(ESMF_KIND_R8) :: min(2), max(2) integer :: status, rank @@ -1262,9 +1261,8 @@ subroutine ESMFL_RegridStore (srcFLD, SRCgrid2D, dstFLD, DSTgrid2D, & ! name="SRC 2D grid", rc=status) !_VERIFY(status) ! instead use the following... - pi = 4.0 * atan(1.0) - deltaX = 2.0*pi/gccpd(1) - deltaY = pi/(gccpd(2)-1) + deltaX = 2.0*MAPL_PI/gccpd(1) + deltaY = MAPL_PI/(gccpd(2)-1) SRCGrid2D = ESMF_GridCreateHorzLatLonUni( & counts = gccpd(1:2), & minGlobalCoordPerDim=min(1:2), & @@ -1371,8 +1369,8 @@ subroutine ESMFL_RegridStore (srcFLD, SRCgrid2D, dstFLD, DSTgrid2D, & ! name="DST 2D grid", rc=status) !_VERIFY(status) ! instead use the following ... - deltaX = 2.0*pi/gccpd(1) - deltaY = pi/(gccpd(2)-1) + deltaX = 2.0*MAPL_PI/gccpd(1) + deltaY = MAPL_PI/(gccpd(2)-1) DSTGrid2D = ESMF_GridCreateHorzLatLonUni( & counts = gccpd(1:2), & minGlobalCoordPerDim=min(1:2), & diff --git a/base/MAPL_AbstractGridFactory.F90 b/base/MAPL_AbstractGridFactory.F90 index a83b41fed7f0..e224d011693d 100644 --- a/base/MAPL_AbstractGridFactory.F90 +++ b/base/MAPL_AbstractGridFactory.F90 @@ -6,6 +6,7 @@ module MAPL_AbstractGridFactoryMod use pFIO use MAPL_ExceptionHandling use MAPL_BaseMod, only: MAPL_UNDEF + use MAPL_Constants use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 use MAPL_KeywordEnforcerMod implicit none @@ -768,7 +769,7 @@ end subroutine cartesian_to_spherical_3d_real64 function get_basis(this,basis,unusable,rc) result(basis_vectors) use esmf use MAPL_KeywordEnforcerMod - use MAPL_ConstantsMod, only : PI => MAPL_PI_R8 + use MAPL_Constants, only : PI => MAPL_PI_R8 real(REAL64), pointer :: basis_vectors(:,:,:,:) character(len=*), intent(in) :: basis class (AbstractGridFactory), target, intent(inout) :: this @@ -965,7 +966,7 @@ function latlon2xyz(sph_coord,right_hand) result(xyz_coord) end function function xyz2latlon(xyz_coord) result(sph_coord) - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 + use MAPL_Constants, only: PI => MAPL_PI_R8 real(REAL64), intent(inout):: xyz_coord(3) real(REAL64) :: sph_coord(2) real(REAL64), parameter:: esl=1.e-10 diff --git a/base/MAPL_AbstractRegridder.F90 b/base/MAPL_AbstractRegridder.F90 index c558352d4cc1..3b7a1c55acb2 100644 --- a/base/MAPL_AbstractRegridder.F90 +++ b/base/MAPL_AbstractRegridder.F90 @@ -2,6 +2,7 @@ module MAPL_AbstractRegridderMod use MAPL_BaseMod, only: MAPL_UNDEF + use MAPL_Constants use mapl_RegridderSpec use mapl_KeywordEnforcerMod use ESMF diff --git a/base/MAPL_CFIO.F90 b/base/MAPL_CFIO.F90 index 15a0a9a85ed2..8ad993b9d64f 100644 --- a/base/MAPL_CFIO.F90 +++ b/base/MAPL_CFIO.F90 @@ -24,7 +24,7 @@ module MAPL_CFIOMod use ESMF use MAPL_BaseMod use MAPL_CommsMod - use MAPL_ConstantsMod + use MAPL_Constants use ESMF_CFIOMod use ESMF_CFIOUtilMod use ESMF_CFIOFileMod @@ -1000,8 +1000,8 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, mcfio%xyoffset = xyoffset else mcfio%xyoffset = 0 - lons1d = MAPL_Range(-180.,180.-(360./IMO), IMO, conversion_factor=MAPL_DEGREES_TO_RADIANS) - lats1d = MAPL_Range(-90., +90., JMO, conversion_factor=MAPL_DEGREES_TO_RADIANS) + lons1d = MAPL_Range(-180.,180.-(360./IMO), IMO, conversion_factor=MAPL_DEGREES_TO_RADIANS_R8) + lats1d = MAPL_Range(-90., +90., JMO, conversion_factor=MAPL_DEGREES_TO_RADIANS_R8) endif endif @@ -5797,7 +5797,7 @@ subroutine get_latlon_from_factory(grid, lons, lats, rc) use MAPL_AbstractGridFactoryMod use MAPL_LatLonGridFactoryMod use MAPL_GridManagerMod - use MAPL_ConstantsMod, only: MAPL_RADIANS_TO_DEGREES + use MAPL_Constants, only: MAPL_RADIANS_TO_DEGREES type (ESMF_GRid), intent(in) :: grid real, intent(out) :: lons(:), lats(:) @@ -5883,8 +5883,8 @@ function make_regridder(esmfgrid, method, lons, lats, im,jm,lm, runparallel, Loc allocate(lons_radians(size(lons))) allocate(lats_radians(size(lats))) - lons_radians = MAPL_DEGREES_TO_RADIANS * lons - lats_radians = MAPL_DEGREES_TO_RADIANS * lats + lons_radians = MAPL_DEGREES_TO_RADIANS_R8 * lons + lats_radians = MAPL_DEGREES_TO_RADIANS_R8 * lats lon_array = ESMF_LocalArrayCreate(lons_radians, rc=status) _VERIFY(status) diff --git a/base/MAPL_Comms.F90 b/base/MAPL_Comms.F90 index 00c0bd20c85b..96f4e10ba12d 100644 --- a/base/MAPL_Comms.F90 +++ b/base/MAPL_Comms.F90 @@ -14,7 +14,7 @@ module MAPL_CommsMod use ESMF use MAPL_BaseMod use MAPL_ShmemMod - use MAPL_ConstantsMod + use MAPL_Constants, only: MAPL_Unknown, MAPL_IsGather, MAPL_IsScatter use MAPL_ExceptionHandling implicit none private @@ -47,10 +47,6 @@ module MAPL_CommsMod public MAPL_RoundRobinPEList public MAPL_BcastShared - integer, parameter, public :: MAPL_Unknown = 0 - integer, parameter, public :: MAPL_IsGather = 1 - integer, parameter, public :: MAPL_IsScatter = 2 - type ArrPtr real, pointer :: A(:,:) end type ArrPtr diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 58c8ee270786..fa437070f4fd 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -17,7 +17,7 @@ module MAPL_CubedSphereGridFactoryMod use ESMF use pFIO use MAPL_CommsMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_IOMod, only : GETFILE, FREE_FILE use, intrinsic :: iso_fortran_env, only: REAL64,REAL32 implicit none @@ -26,13 +26,8 @@ module MAPL_CubedSphereGridFactoryMod public :: CubedSphereGridFactory integer, parameter :: ndims = 2 - integer, parameter :: UNDEFINED_INTEGER = 1-huge(1) - real, parameter :: UNDEFINED_REAL = huge(1.) - real(REAL64), parameter :: UNDEFINED_REAL64 = huge(1.d0) - character(len=*), parameter :: UNDEFINED_CHAR = '**' integer, parameter :: FV_GRID_TYPE_DEFAULT = 0 - character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN' integer, parameter :: NUM_CUBE_FACES = 6 @@ -41,24 +36,24 @@ module MAPL_CubedSphereGridFactoryMod character(len=:), allocatable :: grid_name - integer :: grid_type = UNDEFINED_INTEGER + integer :: grid_type = MAPL_UNDEFINED_INTEGER ! Grid dimensions - Note that we only support "square" grids - integer :: im_world = UNDEFINED_INTEGER - integer :: lm = UNDEFINED_INTEGER + integer :: im_world = MAPL_UNDEFINED_INTEGER + integer :: lm = MAPL_UNDEFINED_INTEGER integer :: ntiles = NUM_CUBE_FACES ! Domain decomposition: - note that we only support "square" dec - integer :: nx = UNDEFINED_INTEGER - integer :: ny = UNDEFINED_INTEGER + integer :: nx = MAPL_UNDEFINED_INTEGER + integer :: ny = MAPL_UNDEFINED_INTEGER integer, allocatable :: ims(:) integer, allocatable :: jms(:) ! rectangle decomposition integer, allocatable :: jms_2d(:,:) ! stretching parameters - real :: stretch_factor = UNDEFINED_REAL - real :: target_lon = UNDEFINED_REAL - real :: target_lat = UNDEFINED_REAL + real :: stretch_factor = MAPL_UNDEFINED_REAL + real :: target_lon = MAPL_UNDEFINED_REAL + real :: target_lat = MAPL_UNDEFINED_REAL logical :: stretched_cube = .false. ! For halo @@ -143,18 +138,18 @@ function CubedSphereGridFactory_from_parameters(unusable, grid_name, grid_type, if (present(unusable)) print*,shape(unusable) - call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT) + call set_with_default(factory%grid_name, grid_name, MAPL_GRID_NAME_DEFAULT) call set_with_default(factory%grid_type, grid_type, FV_GRID_TYPE_DEFAULT) - call set_with_default(factory%nx, nx, UNDEFINED_INTEGER) - call set_with_default(factory%ny, ny, UNDEFINED_INTEGER) + call set_with_default(factory%nx, nx, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%ny, ny, MAPL_UNDEFINED_INTEGER) - call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER) - call set_with_default(factory%lm, lm, UNDEFINED_INTEGER) + call set_with_default(factory%im_world, im_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%lm, lm, MAPL_UNDEFINED_INTEGER) - call set_with_default(factory%stretch_factor,stretch_factor,UNDEFINED_REAL) - call set_with_default(factory%target_lon,target_lon,UNDEFINED_REAL) - call set_with_default(factory%target_lat,target_lat,UNDEFINED_REAL) + call set_with_default(factory%stretch_factor,stretch_factor,MAPL_UNDEFINED_REAL) + call set_with_default(factory%target_lon,target_lon,MAPL_UNDEFINED_REAL) + call set_with_default(factory%target_lat,target_lat,MAPL_UNDEFINED_REAL) ! default is unallocated if (present(ims)) factory%ims = ims @@ -235,8 +230,8 @@ function create_basic_grid(this, unusable, rc) result(grid) staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & transformArgs=transformArgument,rc=status) _VERIFY(status) - if (this%stretch_factor/=UNDEFINED_REAL .and. this%target_lon/=UNDEFINED_REAL .and. & - this%target_lat/=UNDEFINED_REAL) then + if (this%stretch_factor/=MAPL_UNDEFINED_REAL .and. this%target_lon/=MAPL_UNDEFINED_REAL .and. & + this%target_lat/=MAPL_UNDEFINED_REAL) then call ESMF_AttributeSet(grid, name='STRETCH_FACTOR', value=this%stretch_factor,rc=status) _VERIFY(status) call ESMF_AttributeSet(grid, name='TARGET_LON', value=this%target_lon,rc=status) @@ -283,7 +278,7 @@ function create_basic_grid(this, unusable, rc) result(grid) deallocate(ims,jms) - if (this%lm /= UNDEFINED_INTEGER) then + if (this%lm /= MAPL_UNDEFINED_INTEGER) then call ESMF_AttributeSet(grid, name='GRID_LM', value=this%lm, rc=status) _VERIFY(status) end if @@ -406,19 +401,19 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc call ESMF_VMGetCurrent(vm, rc=status) _VERIFY(status) - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=MAPL_GRID_NAME_DEFAULT) this%grid_name = trim(tmp) call ESMF_ConfigGetAttribute(config, this%grid_type, label=prefix//'CS_GRID_TYPE:', default=FV_GRID_TYPE_DEFAULT) - call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=MAPL_UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=MAPL_UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%stretch_factor, label=prefix//'STRETCH_FACTOR:', default=UNDEFINED_REAL) - call ESMF_ConfigGetAttribute(config, this%target_lon, label=prefix//'TARGET_LON:', default=UNDEFINED_REAL) - call ESMF_ConfigGetAttribute(config, this%target_lat, label=prefix//'TARGET_LAT:', default=UNDEFINED_REAL) + call ESMF_ConfigGetAttribute(config, this%stretch_factor, label=prefix//'STRETCH_FACTOR:', default=MAPL_UNDEFINED_REAL) + call ESMF_ConfigGetAttribute(config, this%target_lon, label=prefix//'TARGET_LON:', default=MAPL_UNDEFINED_REAL) + call ESMF_ConfigGetAttribute(config, this%target_lat, label=prefix//'TARGET_LAT:', default=MAPL_UNDEFINED_REAL) call get_multi_integer(this%ims, 'IMS:', rc=status) _VERIFY(status) @@ -432,7 +427,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _VERIFY(status) endif - call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=MAPL_UNDEFINED_INTEGER) call this%check_and_fill_consistency(rc=status) _VERIFY(status) @@ -467,7 +462,7 @@ subroutine get_multi_integer(values, label, rc) ! First pass: count values n = 0 do - call ESMF_ConfigGetAttribute(config, tmp, default=UNDEFINED_INTEGER, rc=status) + call ESMF_ConfigGetAttribute(config, tmp, default=MAPL_UNDEFINED_INTEGER, rc=status) if (status /= _SUCCESS) then exit else @@ -622,7 +617,7 @@ end function to_string subroutine check_and_fill_consistency(this, unusable, rc) use MAPL_BaseMod, only: MAPL_DecomposeDim - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 + use MAPL_Constants, only: PI => MAPL_PI_R8 class (CubedSphereGridFactory), intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -633,16 +628,16 @@ subroutine check_and_fill_consistency(this, unusable, rc) _UNUSED_DUMMY(unusable) if (.not. allocated(this%grid_name)) then - this%grid_name = GRID_NAME_DEFAULT + this%grid_name = MAPL_GRID_NAME_DEFAULT end if - if (this%grid_type == UNDEFINED_INTEGER) then + if (this%grid_type == MAPL_UNDEFINED_INTEGER) then this%grid_type = FV_GRID_TYPE_DEFAULT ! fv default end if - if ( (this%target_lon /= UNDEFINED_REAL) .and. & - (this%target_lat /= UNDEFINED_REAL) .and. & - (this%stretch_factor /= UNDEFINED_REAL) ) then + if ( (this%target_lon /= MAPL_UNDEFINED_REAL) .and. & + (this%target_lat /= MAPL_UNDEFINED_REAL) .and. & + (this%stretch_factor /= MAPL_UNDEFINED_REAL) ) then _ASSERT( (this%target_lat >= -90.0) .and. (this%target_lat <= 90), 'latitude out of range') this%stretched_cube = .true. this%target_lon=this%target_lon*pi/180.d0 @@ -675,13 +670,13 @@ subroutine verify(n, m_world, ms, rc) if (allocated(ms)) then _ASSERT(size(ms) > 0, 'must be > 0 PEs in each dimension') - if (n == UNDEFINED_INTEGER) then + if (n == MAPL_UNDEFINED_INTEGER) then n = size(ms) else _ASSERT(n == size(ms), 'inconsistent specs') end if - if (m_world == UNDEFINED_INTEGER) then + if (m_world == MAPL_UNDEFINED_INTEGER) then m_world = sum(ms) else _ASSERT(m_world == sum(ms), 'inconsistent specs') @@ -689,8 +684,8 @@ subroutine verify(n, m_world, ms, rc) else - _ASSERT(n /= UNDEFINED_INTEGER,'n not specified') - _ASSERT(m_world /= UNDEFINED_INTEGER,'m_wold not specified') + _ASSERT(n /= MAPL_UNDEFINED_INTEGER,'n not specified') + _ASSERT(m_world /= MAPL_UNDEFINED_INTEGER,'m_wold not specified') allocate(ms(n), stat=status) _VERIFY(status) diff --git a/base/MAPL_ExtDataGridCompMod.F90 b/base/MAPL_ExtDataGridCompMod.F90 index 648ffa1c9d6c..cc3ee2cc79c7 100644 --- a/base/MAPL_ExtDataGridCompMod.F90 +++ b/base/MAPL_ExtDataGridCompMod.F90 @@ -33,7 +33,7 @@ MODULE MAPL_ExtDataGridCompMod use ESMF_CFIOUtilMod use MAPL_CFIOMod use MAPL_NewArthParserMod - use MAPL_ConstantsMod, only: MAPL_PI,MAPL_PI_R8,MAPL_RADIANS_TO_DEGREES + use MAPL_Constants, only: MAPL_PI,MAPL_PI_R8,MAPL_RADIANS_TO_DEGREES,MAPL_CF_COMPONENT_SEPARATOR use MAPL_IOMod, only: MAPL_NCIOParseTimeUnits use mapl_RegridMethods use, intrinsic :: iso_fortran_env, only: REAL64 @@ -850,7 +850,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! 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,' unfullfilled imports in extdata' + write(error_msg_str, '(A6,I3,A31)') 'Found ', ItemCount-itemCounter,' unfulfilled imports in extdata' _ASSERT(.false., error_msg_str) end if @@ -2096,7 +2096,7 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) type(ESMF_Time) :: fTime type(ESMF_Field) :: field real, allocatable :: levFile(:) - character(len=ESMF_MAXSTR) :: buff,levunits,tlevunits + character(len=ESMF_MAXSTR) :: buff,levunits,tlevunits,temp_name logical :: found,lFound,intOK integer :: maxOffset character(len=:), allocatable :: levname @@ -2104,12 +2104,19 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) type(FileMetadataUtils), pointer :: metadata type(Variable), pointer :: var type(ESMF_TimeInterval) :: zero + integer :: vect_semi positive=>null() call ESMF_TimeIntervalSet(zero,__RC__) - call ESMF_StateGet(state,trim(item%name),field,__RC__) + vect_semi=index(item%name,";") + if (vect_semi/=0) then + temp_name=item%name(:vect_semi-1) + else + temp_name=item%name + end if + call ESMF_StateGet(state,trim(temp_name),field,__RC__) call ESMF_FieldGet(field,rank=rank,__RC__) if (rank==2) then item%lm=0 @@ -4201,7 +4208,6 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) integer :: NX,NY type(ESMF_Grid) :: newGrid type(ESMF_Config) :: cflocal - character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' real :: temp_real logical :: isPresent @@ -4215,21 +4221,21 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) comp_name = "ExtData" cflocal = MAPL_ConfigCreate(rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"NX:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"LM:",rc=status) _VERIFY(status) if (counts(2) == 6*counts(1)) then - call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"GRID_TYPE:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"NF:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"NY:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) _VERIFY(status) call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', isPresent=isPresent, rc=status) @@ -4237,7 +4243,7 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) if (isPresent) then call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', value=temp_real, rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) _VERIFY(status) endif @@ -4246,7 +4252,7 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) if (isPresent) then call ESMF_AttributeGet(grid, name='TARGET_LON', value=temp_real, rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) _VERIFY(status) endif @@ -4255,17 +4261,17 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) if (isPresent) then call ESMF_AttributeGet(grid, name='TARGET_LAT', value=temp_real, rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) _VERIFY(status) endif else - call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"JM_WORLD:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"NY:",rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) _VERIFY(status) end if newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", rc=status) diff --git a/base/MAPL_ExternalGridFactory.F90 b/base/MAPL_ExternalGridFactory.F90 index 9182156c335e..fda105845f72 100644 --- a/base/MAPL_ExternalGridFactory.F90 +++ b/base/MAPL_ExternalGridFactory.F90 @@ -8,7 +8,7 @@ module MAPL_ExternalGridFactoryMod use ESMF use pFIO use MAPL_CommsMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_IOMod, only : GETFILE, FREE_FILE use, intrinsic :: iso_fortran_env, only: REAL64,REAL32 diff --git a/base/MAPL_Generic.F90 b/base/MAPL_Generic.F90 index 1c2a1bacd35d..aea4bd16617a 100644 --- a/base/MAPL_Generic.F90 +++ b/base/MAPL_Generic.F90 @@ -115,7 +115,7 @@ module MAPL_GenericMod use MAPL_Profiler use MAPL_MemUtilsMod use MAPL_CommsMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_SunMod use MaplGeneric use MAPL_GenericCplCompMod @@ -340,8 +340,6 @@ module MAPL_GenericMod integer, parameter :: LAST_ALARM = 99 -character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' - type MAPL_GenericWrap type(MAPL_MetaComp ), pointer :: MAPLOBJ end type MAPL_GenericWrap @@ -8090,7 +8088,7 @@ pure function get_labels_with_prefix(component_name, label) result(labels_with_p labels_with_prefix(1) = trim(component_name)//"_"//trim(label) labels_with_prefix(2) = trim(component_type)//"_"//trim(label) labels_with_prefix(3) = trim(label) - labels_with_prefix(4) = trim(component_name)//CF_COMPONENT_SEPARATOR//trim(label) + labels_with_prefix(4) = trim(component_name)//MAPL_CF_COMPONENT_SEPARATOR//trim(label) end function get_labels_with_prefix @@ -10004,23 +10002,23 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) _ASSERT(.false.,'needs informative message') endif - call MAPL_ConfigPrepend(state%cf,trim(comp_name),CF_COMPONENT_SEPARATOR,'NX:',rc=status) + call MAPL_ConfigPrepend(state%cf,trim(comp_name),MAPL_CF_COMPONENT_SEPARATOR,'NX:',rc=status) _VERIFY(status) - call MAPL_ConfigPrepend(state%cf,trim(comp_name),CF_COMPONENT_SEPARATOR,'NY:',rc=status) + call MAPL_ConfigPrepend(state%cf,trim(comp_name),MAPL_CF_COMPONENT_SEPARATOR,'NY:',rc=status) _VERIFY(status) - call ESMF_ConfigGetAttribute(state%cf,gridname,label=trim(comp_name)//CF_COMPONENT_SEPARATOR//'GRIDNAME:',rc=status) + call ESMF_ConfigGetAttribute(state%cf,gridname,label=trim(comp_name)//MAPL_CF_COMPONENT_SEPARATOR//'GRIDNAME:',rc=status) _VERIFY(status) nn = len_trim(gridname) dateline = gridname(nn-1:nn) if (dateline == 'CF') then - call ESMF_ConfigGetAttribute(state%CF,ny,label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//'NY:',rc=status) + call ESMF_ConfigGetAttribute(state%CF,ny,label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//'NY:',rc=status) _VERIFY(status) - call MAPL_ConfigSetAttribute(state%CF, value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//'NY:',rc=status) + call MAPL_ConfigSetAttribute(state%CF, value=ny/6, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//'NY:',rc=status) _VERIFY(status) end if - grid = grid_manager%make_grid(state%CF, prefix=trim(COMP_Name)//CF_COMPONENT_SEPARATOR, rc=status) + grid = grid_manager%make_grid(state%CF, prefix=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR, rc=status) _VERIFY(status) call state%grid%set(grid, __RC__) diff --git a/base/MAPL_GenericCplComp.F90 b/base/MAPL_GenericCplComp.F90 index dedad839d6b9..e79afa96ee73 100644 --- a/base/MAPL_GenericCplComp.F90 +++ b/base/MAPL_GenericCplComp.F90 @@ -22,7 +22,7 @@ module MAPL_GenericCplCompMod use ESMF use ESMFL_Mod use MAPL_BaseMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_IOMod use MAPL_CommsMod use MAPL_ProfMod diff --git a/base/MAPL_GridManager.F90 b/base/MAPL_GridManager.F90 index ae865b1ac580..0b47472a5cb5 100644 --- a/base/MAPL_GridManager.F90 +++ b/base/MAPL_GridManager.F90 @@ -62,8 +62,6 @@ module MAPL_GridManager_private end type GridManager - integer(kind=INT64), parameter :: NOT_FOUND = 1 - HUGE(1_INT64) - character(len=*), parameter :: MOD_NAME = 'MAPL_GridManager_private::' character(len=*), parameter :: factory_id_attribute = 'MAPL_grid_factory_id' @@ -230,8 +228,6 @@ function make_grid_from_config(this, config, unusable, prefix, rc) result(grid) character(len=:), allocatable :: label - character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' - _UNUSED_DUMMY(unusable) label = 'GRID_TYPE:' diff --git a/base/MAPL_GridSpec.F90 b/base/MAPL_GridSpec.F90 index 8d6dc6e6788e..321aa47f1de9 100644 --- a/base/MAPL_GridSpec.F90 +++ b/base/MAPL_GridSpec.F90 @@ -6,9 +6,6 @@ module MAPL_GridSpecMod public :: GridSpec public :: DimensionSpec ! parameters - public :: MAPL_DimTopoCyclic - public :: MAPL_DimTopoEdge - public :: MAPL_DimTopoCenter integer, parameter :: NUM_DIMS = 2 @@ -37,10 +34,6 @@ module MAPL_GridSpecMod end type GridSpec - integer, parameter :: MAPL_DimTopoCyclic = 0 - integer, parameter :: MAPL_DimTopoEdge = -1 - integer, parameter :: MAPL_DimTopoCenter = 1 - contains diff --git a/base/MAPL_LatLonGridFactory.F90 b/base/MAPL_LatLonGridFactory.F90 index 7b6b901a35d2..49061e9b675b 100644 --- a/base/MAPL_LatLonGridFactory.F90 +++ b/base/MAPL_LatLonGridFactory.F90 @@ -11,7 +11,7 @@ module MAPL_LatLonGridFactoryMod use MAPL_MinMaxMod use MAPL_KeywordEnforcerMod use mapl_ErrorHandlingMod - use MAPL_ConstantsMod + use MAPL_Constants use ESMF use pFIO use MAPL_CommsMod @@ -24,20 +24,15 @@ module MAPL_LatLonGridFactoryMod public :: LatLonGridFactory integer, parameter :: NUM_DIM = 2 - integer, parameter :: UNDEFINED_INTEGER = 1-huge(1) - real, parameter :: UNDEFINED_REAL = huge(1.) - character(len=*), parameter :: UNDEFINED_CHAR = '**' - - character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN' type, extends(AbstractGridFactory) :: LatLonGridFactory private logical :: is_regular = .false. character(len=:), allocatable :: grid_name ! Grid dimensions - integer :: im_world = UNDEFINED_INTEGER - integer :: jm_world = UNDEFINED_INTEGER - integer :: lm = UNDEFINED_INTEGER + integer :: im_world = MAPL_UNDEFINED_INTEGER + integer :: jm_world = MAPL_UNDEFINED_INTEGER + integer :: lm = MAPL_UNDEFINED_INTEGER real(kind=REAL64), allocatable :: lon_centers(:) real(kind=REAL64), allocatable :: lat_centers(:) real(kind=REAL64), allocatable :: lon_corners(:) @@ -45,16 +40,16 @@ module MAPL_LatLonGridFactoryMod logical :: force_decomposition = .false. ! Domain decomposition: - integer :: nx = UNDEFINED_INTEGER - integer :: ny = UNDEFINED_INTEGER + integer :: nx = MAPL_UNDEFINED_INTEGER + integer :: ny = MAPL_UNDEFINED_INTEGER integer, allocatable :: ims(:) integer, allocatable :: jms(:) ! Grid conventions: character(len=:), allocatable :: pole character(len=:), allocatable :: dateline ! Regional vs global: - type (RealMinMax) :: lon_range = RealMinMax(UNDEFINED_REAL,UNDEFINED_REAL) - type (RealMinMax) :: lat_range = RealMinMax(UNDEFINED_REAL,UNDEFINED_REAL) + type (RealMinMax) :: lon_range = RealMinMax(MAPL_UNDEFINED_REAL,MAPL_UNDEFINED_REAL) + type (RealMinMax) :: lat_range = RealMinMax(MAPL_UNDEFINED_REAL,MAPL_UNDEFINED_REAL) ! Used for halo type (ESMF_DELayout) :: layout integer :: px, py @@ -210,24 +205,24 @@ function LatLonGridFactory_from_parameters(unusable, grid_name, & _UNUSED_DUMMY(unusable) factory%is_regular = .true. - call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT) + call set_with_default(factory%grid_name, grid_name, MAPL_GRID_NAME_DEFAULT) - call set_with_default(factory%nx, nx, UNDEFINED_INTEGER) - call set_with_default(factory%ny, ny, UNDEFINED_INTEGER) + call set_with_default(factory%nx, nx, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%ny, ny, MAPL_UNDEFINED_INTEGER) - call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER) - call set_with_default(factory%jm_world, jm_world, UNDEFINED_INTEGER) - call set_with_default(factory%lm, lm, UNDEFINED_INTEGER) + call set_with_default(factory%im_world, im_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%jm_world, jm_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%lm, lm, MAPL_UNDEFINED_INTEGER) ! default is unallocated if (present(ims)) factory%ims = ims if (present(jms)) factory%jms = jms - call set_with_default(factory%pole, pole, UNDEFINED_CHAR) - call set_with_default(factory%dateline, dateline, UNDEFINED_CHAR) + call set_with_default(factory%pole, pole, MAPL_UNDEFINED_CHAR) + call set_with_default(factory%dateline, dateline, MAPL_UNDEFINED_CHAR) - call set_with_default(factory%lon_range, lon_range, RealMinMax(UNDEFINED_REAL,UNDEFINED_REAL)) - call set_with_default(factory%lat_range, lat_range, RealMinMax(UNDEFINED_REAL,UNDEFINED_REAL)) + call set_with_default(factory%lon_range, lon_range, RealMinMax(MAPL_UNDEFINED_REAL,MAPL_UNDEFINED_REAL)) + call set_with_default(factory%lat_range, lat_range, RealMinMax(MAPL_UNDEFINED_REAL,MAPL_UNDEFINED_REAL)) call set_with_default(factory%force_decomposition, force_decomposition, .false.) call factory%check_and_fill_consistency(rc=status) @@ -314,7 +309,7 @@ function create_basic_grid(this, unusable, rc) result(grid) _VERIFY(status) - if (this%lm /= UNDEFINED_INTEGER) then + if (this%lm /= MAPL_UNDEFINED_INTEGER) then call ESMF_AttributeSet(grid, name='GRID_LM', value=this%lm, rc=status) _VERIFY(status) end if @@ -360,7 +355,7 @@ end function get_latitudes ! in radians function compute_lon_centers(this, dateline, unusable, rc) result(lon_centers) - use MAPL_ConstantsMod, only:MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only:MAPL_DEGREES_TO_RADIANS_R8 use MAPL_BaseMod real(kind=REAL64), allocatable :: lon_centers(:) class (LatLonGridFactory), intent(in) :: this @@ -400,14 +395,14 @@ function compute_lon_centers(this, dateline, unusable, rc) result(lon_centers) end if lon_centers = MAPL_Range(min_coord, max_coord, this%im_world, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS, rc=status) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8, rc=status) _VERIFY(status) _RETURN(_SUCCESS) end function compute_lon_centers function compute_lon_corners(this, dateline, unusable, rc) result(lon_corners) - use MAPL_ConstantsMod, only:MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only:MAPL_DEGREES_TO_RADIANS_R8 use MAPL_BaseMod real(kind=REAL64), allocatable :: lon_corners(:) class (LatLonGridFactory), intent(in) :: this @@ -447,7 +442,7 @@ function compute_lon_corners(this, dateline, unusable, rc) result(lon_corners) end if lon_corners = MAPL_Range(min_coord, max_coord, this%im_world+1, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS, rc=status) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8, rc=status) _VERIFY(status) _RETURN(_SUCCESS) @@ -487,7 +482,7 @@ end function get_lat_corners function compute_lat_centers(this, pole, unusable, rc) result(lat_centers) - use MAPL_ConstantsMod, only: MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only: MAPL_DEGREES_TO_RADIANS_R8 use MAPL_BaseMod real(kind=REAL64), allocatable :: lat_centers(:) class (LatLonGridFactory), intent(in) :: this @@ -523,14 +518,14 @@ function compute_lat_centers(this, pole, unusable, rc) result(lat_centers) end if lat_centers = MAPL_Range(min_coord, max_coord, this%jm_world, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS, rc=status) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8, rc=status) _RETURN(_SUCCESS) end function compute_lat_centers function compute_lat_corners(this, pole, unusable, rc) result(lat_corners) - use MAPL_ConstantsMod, only: MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only: MAPL_DEGREES_TO_RADIANS_R8 use MAPL_BaseMod real(kind=REAL64), allocatable :: lat_corners(:) class (LatLonGridFactory), intent(in) :: this @@ -568,10 +563,10 @@ function compute_lat_corners(this, pole, unusable, rc) result(lat_corners) end if lat_corners = MAPL_Range(min_coord, max_coord, this%jm_world+1, & - & conversion_factor=MAPL_DEGREES_TO_RADIANS, rc=status) + & conversion_factor=MAPL_DEGREES_TO_RADIANS_R8, rc=status) if (pole == 'PC') then - lat_corners(1)=-90.d0*MAPL_DEGREES_TO_RADIANS - lat_corners(this%jm_world+1)=90.d0*MAPL_DEGREES_TO_RADIANS + lat_corners(1)=-90.d0*MAPL_DEGREES_TO_RADIANS_R8 + lat_corners(this%jm_world+1)=90.d0*MAPL_DEGREES_TO_RADIANS_R8 end if _RETURN(_SUCCESS) @@ -869,10 +864,10 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi if (use_file_coords) then this%is_regular = .false. - this%lon_centers = MAPL_DEGREES_TO_RADIANS * this%lon_centers - this%lat_centers = MAPL_DEGREES_TO_RADIANS * this%lat_centers - this%lon_corners = MAPL_DEGREES_TO_RADIANS * this%lon_corners - this%lat_corners = MAPL_DEGREES_TO_RADIANS * this%lat_corners + this%lon_centers = MAPL_DEGREES_TO_RADIANS_R8 * this%lon_centers + this%lat_centers = MAPL_DEGREES_TO_RADIANS_R8 * this%lat_centers + this%lon_corners = MAPL_DEGREES_TO_RADIANS_R8 * this%lon_corners + this%lat_corners = MAPL_DEGREES_TO_RADIANS_R8 * this%lat_corners else compute_lons=.false. compute_lats=.false. @@ -892,10 +887,10 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi this%lat_corners = this%compute_lat_corners(this%pole, rc=status) _VERIFY(status) else - this%lon_centers = MAPL_DEGREES_TO_RADIANS * this%lon_centers - this%lat_centers = MAPL_DEGREES_TO_RADIANS * this%lat_centers - this%lon_corners = MAPL_DEGREES_TO_RADIANS * this%lon_corners - this%lat_corners = MAPL_DEGREES_TO_RADIANS * this%lat_corners + this%lon_centers = MAPL_DEGREES_TO_RADIANS_R8 * this%lon_centers + this%lat_centers = MAPL_DEGREES_TO_RADIANS_R8 * this%lat_centers + this%lon_corners = MAPL_DEGREES_TO_RADIANS_R8 * this%lon_corners + this%lat_corners = MAPL_DEGREES_TO_RADIANS_R8 * this%lat_corners end if end if @@ -938,14 +933,14 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _VERIFY(status) this%is_regular = .true. - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=MAPL_GRID_NAME_DEFAULT) this%grid_name = trim(tmp) - call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=MAPL_UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=MAPL_UNDEFINED_INTEGER) call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'IMS_FILE:', rc=status) if ( status == _SUCCESS ) then @@ -964,13 +959,13 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _VERIFY(status) endif - call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=MAPL_UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'POLE:', default=UNDEFINED_CHAR, rc=status) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'POLE:', default=MAPL_UNDEFINED_CHAR, rc=status) if (status == _SUCCESS) then this%pole = trim(tmp) end if - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'DATELINE:', default=UNDEFINED_CHAR, rc=status) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'DATELINE:', default=MAPL_UNDEFINED_CHAR, rc=status) if (status == _SUCCESS) then this%dateline = trim(tmp) end if @@ -1128,7 +1123,7 @@ subroutine check_and_fill_consistency(this, unusable, rc) _UNUSED_DUMMY(unusable) if (.not. allocated(this%grid_name)) then - this%grid_name = GRID_NAME_DEFAULT + this%grid_name = MAPL_GRID_NAME_DEFAULT end if ! Check decomposition/bounds @@ -1140,21 +1135,21 @@ subroutine check_and_fill_consistency(this, unusable, rc) ! Check regional vs global if (this%pole == 'XY') then ! regional this%periodic = .false. - _ASSERT(this%lat_range%min /= UNDEFINED_REAL, 'uninitialized min for lat_range') - _ASSERT(this%lat_range%max /= UNDEFINED_REAL, 'uninitialized min for lat_range') + _ASSERT(this%lat_range%min /= MAPL_UNDEFINED_REAL, 'uninitialized min for lat_range') + _ASSERT(this%lat_range%max /= MAPL_UNDEFINED_REAL, 'uninitialized min for lat_range') else ! global _ASSERT(any(this%pole == ['PE', 'PC']), 'unsupported option for pole:'//this%pole) - _ASSERT(this%lat_range%min == UNDEFINED_REAL, 'inconsistent min for lat_range') - _ASSERT(this%lat_range%max == UNDEFINED_REAL, 'inconsistent max for lat_range') + _ASSERT(this%lat_range%min == MAPL_UNDEFINED_REAL, 'inconsistent min for lat_range') + _ASSERT(this%lat_range%max == MAPL_UNDEFINED_REAL, 'inconsistent max for lat_range') end if if (this%dateline == 'XY') then this%periodic = .false. - _ASSERT(this%lon_range%min /= UNDEFINED_REAL, 'uninitialized min for lon_range') - _ASSERT(this%lon_range%max /= UNDEFINED_REAL, 'uninitialized max for lon_range') + _ASSERT(this%lon_range%min /= MAPL_UNDEFINED_REAL, 'uninitialized min for lon_range') + _ASSERT(this%lon_range%max /= MAPL_UNDEFINED_REAL, 'uninitialized max for lon_range') else _ASSERT(any(this%dateline == ['DC', 'DE', 'GC', 'GE']), 'unsupported option for dateline') - _ASSERT(this%lon_range%min == UNDEFINED_REAL, 'inconsistent min for lon_range') - _ASSERT(this%lon_range%max == UNDEFINED_REAL, 'inconsistent max for lon_range') + _ASSERT(this%lon_range%min == MAPL_UNDEFINED_REAL, 'inconsistent min for lon_range') + _ASSERT(this%lon_range%max == MAPL_UNDEFINED_REAL, 'inconsistent max for lon_range') end if if (.not.this%force_decomposition) then verify_decomp = this%check_decomposition(rc=status) @@ -1180,13 +1175,13 @@ subroutine verify(n, m_world, ms, rc) if (allocated(ms)) then _ASSERT(size(ms) > 0, 'degenerate topology') - if (n == UNDEFINED_INTEGER) then + if (n == MAPL_UNDEFINED_INTEGER) then n = size(ms) else _ASSERT(n == size(ms), 'inconsistent topology') end if - if (m_world == UNDEFINED_INTEGER) then + if (m_world == MAPL_UNDEFINED_INTEGER) then m_world = sum(ms) else _ASSERT(m_world == sum(ms), 'inconsistent decomponsition') @@ -1194,8 +1189,8 @@ subroutine verify(n, m_world, ms, rc) else - _ASSERT(n /= UNDEFINED_INTEGER, 'uninitialized topology') - _ASSERT(m_world /= UNDEFINED_INTEGER,'uninitialized dimension') + _ASSERT(n /= MAPL_UNDEFINED_INTEGER, 'uninitialized topology') + _ASSERT(m_world /= MAPL_UNDEFINED_INTEGER,'uninitialized dimension') allocate(ms(n), stat=status) _VERIFY(status) !call MAPL_DecomposeDim(m_world, ms, n, min_DE_extent=2) @@ -1283,7 +1278,7 @@ end subroutine set_with_default_logical ! input files. subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) use MAPL_ConfigMod - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 + use MAPL_Constants, only: PI => MAPL_PI_R8 class (LatLonGridFactory), intent(inout) :: this type (ESMF_DistGrid), intent(in) :: dist_grid type (ESMF_LocalArray), intent(in) :: lon_array @@ -1756,7 +1751,7 @@ end subroutine halo subroutine append_metadata(this, metadata) - use MAPL_ConstantsMod + use MAPL_Constants class (LatLonGridFactory), intent(inout) :: this type (FileMetadata), intent(inout) :: metadata diff --git a/base/MAPL_LatLonToLatLonRegridder.F90 b/base/MAPL_LatLonToLatLonRegridder.F90 index a8615380b00f..af0a77dffa3f 100644 --- a/base/MAPL_LatLonToLatLonRegridder.F90 +++ b/base/MAPL_LatLonToLatLonRegridder.F90 @@ -6,6 +6,7 @@ module MAPL_LatLonToLatLonRegridderMod use mapl_RegridMethods use MAPL_KeywordEnforcerMod use mapl_ErrorHandlingMod + use MAPL_Constants use ESMF use, intrinsic :: iso_fortran_env, only: REAL32 @@ -473,7 +474,7 @@ subroutine initialize_subclass(this, unusable, rc) use MAPL_RegridderSpec use MAPL_BaseMod, only: MAPL_GridGet use MAPL_GetLatLonCoordMod - use MAPL_ConstantsMod, only: MAPL_PI_R8 + use MAPL_Constants, only: MAPL_PI_R8 class (LatLonToLatLonRegridder), intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc diff --git a/base/MAPL_LlcGridFactory.F90 b/base/MAPL_LlcGridFactory.F90 index e20ae3a54f85..cd2d0dcbb587 100644 --- a/base/MAPL_LlcGridFactory.F90 +++ b/base/MAPL_LlcGridFactory.F90 @@ -12,6 +12,7 @@ module MAPL_LlcGridFactoryMod use MAPL_AbstractGridFactoryMod use MAPL_KeywordEnforcerMod use mapl_ErrorHandlingMod + use MAPL_Constants use ESMF use pFIO use, intrinsic :: iso_fortran_env, only: REAL32 @@ -22,23 +23,18 @@ module MAPL_LlcGridFactoryMod public :: LlcGridFactory integer, parameter :: NUM_DIM = 2 - integer, parameter :: UNDEFINED_INTEGER = 1-huge(1) - character(len=*), parameter :: UNDEFINED_CHAR = '**' - - character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN' - character(len=*), parameter :: GRID_FILE_NAME_DEFAULT = 'UNKNOWN' type, extends(AbstractGridFactory) :: LlcGridFactory private character(len=:), allocatable :: grid_file_name character(len=:), allocatable :: grid_name ! Grid dimensions - integer :: im_world = UNDEFINED_INTEGER - integer :: jm_world = UNDEFINED_INTEGER + integer :: im_world = MAPL_UNDEFINED_INTEGER + integer :: jm_world = MAPL_UNDEFINED_INTEGER integer :: lm ! Domain decomposition: - integer :: nx = UNDEFINED_INTEGER - integer :: ny = UNDEFINED_INTEGER + integer :: nx = MAPL_UNDEFINED_INTEGER + integer :: ny = MAPL_UNDEFINED_INTEGER integer, allocatable :: ims(:) integer, allocatable :: jms(:) ! Used for halo @@ -114,14 +110,14 @@ function LlcGridFactory_from_parameters(unusable, grid_file_name, grid_name, & if (present(unusable)) print*,shape(unusable) - call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT) - call set_with_default(factory%grid_file_name, grid_file_name, GRID_FILE_NAME_DEFAULT) + call set_with_default(factory%grid_name, grid_name, MAPL_GRID_NAME_DEFAULT) + call set_with_default(factory%grid_file_name, grid_file_name, MAPL_GRID_FILE_NAME_DEFAULT) - call set_with_default(factory%ny, nx, UNDEFINED_INTEGER) - call set_with_default(factory%nx, ny, UNDEFINED_INTEGER) - call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER) - call set_with_default(factory%jm_world, jm_world, UNDEFINED_INTEGER) - call set_with_default(factory%lm, lm, UNDEFINED_INTEGER) + call set_with_default(factory%ny, nx, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%nx, ny, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%im_world, im_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%jm_world, jm_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%lm, lm, MAPL_UNDEFINED_INTEGER) @@ -185,7 +181,7 @@ function create_basic_grid(this, unusable, rc) result(grid) call ESMF_GridAddCoord(grid, rc=status) _VERIFY(status) - if (this%lm /= UNDEFINED_INTEGER) then + if (this%lm /= MAPL_UNDEFINED_INTEGER) then call ESMF_AttributeSet(grid, name='GRID_LM', value=this%lm, rc=status) _VERIFY(status) end if @@ -200,7 +196,7 @@ subroutine add_horz_coordinates(this, grid, unusable, rc) use MAPL_BaseMod, only: MAPL_grid_interior, MAPL_gridget use MAPL_CommsMod use MAPL_IOMod - use MAPL_ConstantsMod + use MAPL_Constants class (LlcGridFactory), intent(in) :: this type (ESMF_Grid), intent(inout) :: grid class (KeywordEnforcer), optional, intent(in) :: unusable @@ -309,18 +305,18 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc if (present(unusable)) print*,shape(unusable) - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=MAPL_GRID_NAME_DEFAULT) this%grid_name = trim(tmp) call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDSPEC:', rc=status) _VERIFY(status) this%grid_file_name = trim(tmp) - call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=MAPL_UNDEFINED_INTEGER) call this%check_and_fill_consistency(rc=status) @@ -399,7 +395,7 @@ subroutine check_and_fill_consistency(this, unusable, rc) _UNUSED_DUMMY(unusable) if (.not. allocated(this%grid_name)) then - this%grid_name = GRID_NAME_DEFAULT + this%grid_name = MAPL_GRID_NAME_DEFAULT end if ! Check decomposition/bounds @@ -428,13 +424,13 @@ subroutine verify(n, m_world, ms, rc) if (allocated(ms)) then _ASSERT(size(ms) > 0, 'degenerate topology') - if (n == UNDEFINED_INTEGER) then + if (n == MAPL_UNDEFINED_INTEGER) then n = size(ms) else _ASSERT(n == size(ms), 'inconsistent topology') end if - if (m_world == UNDEFINED_INTEGER) then + if (m_world == MAPL_UNDEFINED_INTEGER) then m_world = sum(ms) else _ASSERT(m_world == sum(ms), 'inconsistent decomposition') @@ -442,8 +438,8 @@ subroutine verify(n, m_world, ms, rc) else - _ASSERT(n /= UNDEFINED_INTEGER, 'uninitialized topology') - _ASSERT(m_world /= UNDEFINED_INTEGER, 'uninitialized dimension') + _ASSERT(n /= MAPL_UNDEFINED_INTEGER, 'uninitialized topology') + _ASSERT(m_world /= MAPL_UNDEFINED_INTEGER, 'uninitialized dimension') allocate(ms(n), stat=status) _VERIFY(status) call MAPL_DecomposeDim(m_world, ms, n) @@ -490,7 +486,7 @@ end subroutine set_with_default_character ! input files. subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) use MAPL_ConfigMod - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 + use MAPL_Constants, only: PI => MAPL_PI_R8 class (LlcGridFactory), intent(inout) :: this type (ESMF_DistGrid), intent(in) :: dist_grid type (ESMF_LocalArray), intent(in) :: lon_array diff --git a/base/MAPL_LocStreamFactoryMod.F90 b/base/MAPL_LocStreamFactoryMod.F90 index 1779a79fc289..f3e1abbf2847 100644 --- a/base/MAPL_LocStreamFactoryMod.F90 +++ b/base/MAPL_LocStreamFactoryMod.F90 @@ -6,7 +6,7 @@ module LocStreamFactoryMod use ESMF use MAPL_ErrorHandlingMod use MAPL_KeywordEnforcerMod - use MAPL_ConstantsMod + use MAPL_Constants use, intrinsic :: iso_fortran_env, only: REAL32 use, intrinsic :: iso_fortran_env, only: REAL64 implicit none diff --git a/base/MAPL_LocStreamMod.F90 b/base/MAPL_LocStreamMod.F90 index 7bdb9eb75969..4d9ecc14ede2 100644 --- a/base/MAPL_LocStreamMod.F90 +++ b/base/MAPL_LocStreamMod.F90 @@ -18,7 +18,7 @@ module MAPL_LocStreamMod use ESMF use ESMFL_Mod use MAPL_BaseMod -use MAPL_ConstantsMod +use MAPL_Constants use MAPL_IOMod use MAPL_CommsMod use MAPL_HashMod diff --git a/base/MAPL_Mod.F90 b/base/MAPL_Mod.F90 index 064a76c67cb3..ae33699abf9b 100644 --- a/base/MAPL_Mod.F90 +++ b/base/MAPL_Mod.F90 @@ -13,7 +13,9 @@ module MAPL_Mod use MAPL_CommsMod use MAPL_GenericMod use MAPL_VarSpecMod +! For temporary backward compatibility after Constants Library use MAPL_ConstantsMod + use MAPL_ConstantsMod, only: MAPL_PI_R8 use MAPL_ConfigMod use MAPL_SortMod use MAPL_ProfMod diff --git a/base/MAPL_NominalOrbitsMod.F90 b/base/MAPL_NominalOrbitsMod.F90 index ad1b020d335e..876b44cf477a 100644 --- a/base/MAPL_NominalOrbitsMod.F90 +++ b/base/MAPL_NominalOrbitsMod.F90 @@ -1,5 +1,6 @@ #include "unused_dummy.H" - MODULE MAPL_NominalOrbitsMod + MODULE MAPL_NominalOrbitsMod + use MAPL_Constants IMPLICIT NONE !BOP @@ -73,7 +74,6 @@ MODULE MAPL_NominalOrbitsMod /) ! Earth/Time related constants - REAL(dp), PARAMETER :: g0 = 0.000072921158553 !rad per seconds REAL(dp), PARAMETER :: g1p = 0.0172027912; ! increase in the lon of GR per day (rad/day) ! g2p need to be calculated (optimized) version in matlab values are copied here @@ -108,11 +108,7 @@ MODULE MAPL_NominalOrbitsMod ! 3-Other Coef - REAL(dp), PARAMETER :: pi=3.141592653589793 - REAL(dp), PARAMETER :: earth_radius=6371.0 !sphere REAL(dp), PARAMETER :: myeps = 0.0000001 !for zero checks - REAL(dp), PARAMETER :: cdeg2km = earth_radius * (pi / 180.0) ! constant for deg2km - REAL(dp), PARAMETER :: ckm2deg = (1.0/earth_radius) * (180.0/pi) @@ -625,7 +621,7 @@ SUBROUTINE find_sweeppoints(iii, latwayp, longwayp, l, r, wrapon, latlonshift) CALL linspace(r,l,iii,myvec) end if do i=1, size(myvec) - myvec_deg(i) = ckm2deg * myvec(i) + myvec_deg(i) = MAPL_KM_PER_DEG * myvec(i) end do DO say = 1,size(myvec) ALLOCATE(latshift1(1:size(longwayp)),lonshift1(1:size(longwayp))) @@ -710,17 +706,19 @@ SUBROUTINE ECI2ECEF(iSat,fraction2day, ECI_est, ECEF_est) REAL(dp) :: Goft, a1, a2 REAL(dp) :: fraction2day - t1 = Day2year(iSat) - Goft = g0 + g1p*t1 + g2p(iSat) * fraction2day - a1 = cos(Goft); - a2 = sin(Goft); - RotM = 0.0 - RotM(1,1) = a1 - RotM(1,2) = a2 - RotM(2,1) = -a2 - RotM(2,2) = a1 - RotM(3,3) = 1 - ECEF_est = MATMUL(RotM, ECI_est) + associate(g0 => MAPL_OMEGA_R8) + t1 = Day2year(iSat) + Goft = g0 + g1p*t1 + g2p(iSat) * fraction2day + a1 = cos(Goft); + a2 = sin(Goft); + RotM = 0.0 + RotM(1,1) = a1 + RotM(1,2) = a2 + RotM(2,1) = -a2 + RotM(2,2) = a1 + RotM(3,3) = 1 + ECEF_est = MATMUL(RotM, ECI_est) + end associate END SUBROUTINE ECI2ECEF SUBROUTINE get_time(iSat, nymd, nhms, fraction2day, ntime_day) @@ -764,28 +762,27 @@ SUBROUTINE ECEF2LLA(x, y, z, lat, lon, alt) REAL(dp), INTENT(IN) :: x,y,z REAL(dp), INTENT(OUT) :: lat,lon,alt ! % WGS84 ellipsoid constants: - REAL(dp), PARAMETER :: a = 6378137 ! those should be defined outside - REAL(dp), PARAMETER :: e = 8.1819190842622e-2 - REAL(dp), PARAMETER :: pi = 3.14159265358979323846 REAL(dp) :: b, ep, p, th, N - b = sqrt(a**2 * (1-e**2)) - ep = sqrt((a**2-b**2)/b**2) - p = sqrt(x**2+y**2) - th = atan2(a*z,b*p) - lon = atan2(y,x) - lat = atan2((z+ep**2*b*sin(th)**3),(p-e**2*a*cos(th)**3)) - N = a/sqrt(1-e**2*sin(lat)**2) - alt = p/cos(lat)-N -!% !return lon in range [0,2*pi) - !lon = mod(lon,2*pi) ! does not the same as matlab - lon = lon-floor(lon/(2*pi))*(2*pi) -! % correct for numerical instability in altitude near exact poles: -! % (after this correction, error is about 2 millimeters, which is about -! % the same as the numerical precision of the overall function) - !k= (abs(x)<1.AND.abs(y)<1 ) - !print *, k - !!alt(k) = abs(z(k))-b + associate(a => MAPL_EARTH_SEMIMAJOR_AXIS, e => MAPL_EARTH_ECCENTRICITY, pi => MAPL_PI_R8) + b = sqrt(a**2 * (1-e**2)) + ep = sqrt((a**2-b**2)/b**2) + p = sqrt(x**2+y**2) + th = atan2(a*z,b*p) + lon = atan2(y,x) + lat = atan2((z+ep**2*b*sin(th)**3),(p-e**2*a*cos(th)**3)) + N = a/sqrt(1-e**2*sin(lat)**2) + alt = p/cos(lat)-N +!% !return lon in range [0,2*pi) + !lon = mod(lon,2*pi) ! does not the same as matlab + lon = lon-floor(lon/(2*pi))*(2*pi) +! % correct for numerical instability in altitude near exact poles: +! % (after this correction, error is about 2 millimeters, which is about +! % the same as the numerical precision of the overall function) + !k= (abs(x)<1.AND.abs(y)<1 ) + !print *, k + !!alt(k) = abs(z(k))-b + end associate END SUBROUTINE ECEF2LLA integer function ODS_Julian ( CalDate ) @@ -873,33 +870,19 @@ SUBROUTINE build_array(s,e,dp, mat) end do END SUBROUTINE build_array -REAL(dp) FUNCTION deg2km(angle) - IMPLICIT NONE - REAL(dp) angle - - deg2km = earth_radius * deg2rad(angle) -END FUNCTION deg2km - -REAL(dp) FUNCTION km2deg(r) - IMPLICIT NONE - REAL(dp) :: r, rad - - rad = r/earth_radius - km2deg = rad2deg(rad) -END FUNCTION km2deg REAL(dp) FUNCTION deg2rad(angle) IMPLICIT NONE REAL(dp), INTENT(IN) :: angle - deg2rad = (pi/180.0) * angle + deg2rad = MAPL_DEGREES_TO_RADIANS_R8 * angle END FUNCTION deg2rad REAL(dp) FUNCTION rad2deg(rad) IMPLICIT NONE REAL(dp), INTENT(IN) :: rad - rad2deg = (180.0/pi) * rad + rad2deg = MAPL_RADIANS_TO_DEGREES * rad END FUNCTION rad2deg REAL(dp) FUNCTION get_distance(lt1, ln1, lt2, ln2) @@ -939,25 +922,28 @@ REAL(dp) FUNCTION get_azimuth(lt1, ln1, lt2, ln2, wrapon) ! need to be sin(lat1) * cos(lat2) * cos(lon2-lon1)) ! Azimuths are undefined at the poles, so we choose a convention: zero at ! the north pole and pi at the south pole. - if (lat1 <= -pi/2.0) az = 0.0 - if (lat2 >= pi/2.0) az = 0.0 - if (lat2 <= -pi/2.0) az = pi - if (lat1 >= pi/2.0) az = pi - epsilone = 1.74E-8 - + associate(pi => MAPL_PI_R8) + if (lat1 <= -pi/2.0) az = 0.0 + if (lat2 >= pi/2.0) az = 0.0 + if (lat2 <= -pi/2.0) az = pi + if (lat1 >= pi/2.0) az = pi + epsilone = 1.74E-8 + + + if (wrapon) then + if ( az>-epsilone .AND. az < epsilone) then + saz = 0 + else + saz = az/abs(az) + end if + az = pi*((abs(az)/pi) - 2*ceiling(((abs(az)/pi)-1)/2)) * saz + end if - if (wrapon) then - if ( az>-epsilone .AND. az < epsilone) then - saz = 0 - else - saz = az/abs(az) - end if - az = pi*((abs(az)/pi) - 2*ceiling(((abs(az)/pi)-1)/2)) * saz - end if + if ( az < -epsilone) then ! change to 0 to 2pi + az = az + 2*pi + end if + end associate - if ( az < -epsilone) then ! change to 0 to 2pi - az = az + 2*pi - end if ! Reset near-zero points if (az<0.0) az=0 get_azimuth = rad2deg(az) @@ -983,22 +969,25 @@ SUBROUTINE get_reckon(phi1, lambda1, az1, rng1, phi, lambda, wrapon) lambda0 = deg2rad(lambda1) az = deg2rad(az1) rng = deg2rad(rng1) - if (phi0 >= pi/2-epsilone) az = pi ! starting at north pole - if (phi0 <= epsilone-pi/2) az = 0 ! starting at south pole - ! Calculate coordinates of great circle end point using spherical trig. - phi = asin(sin(phi0)*cos(rng) + cos(phi0)*sin(rng)*cos(az)) - lambda = lambda0 + atan2( sin(rng)*sin(az), & - cos(phi0)*cos(rng) - sin(phi0)*sin(rng)*cos(az) ) - - if (wrapon) then - if ( lambda>-epsilone .AND. lambda < epsilone) then - saz = 0 - else - saz = lambda/abs(lambda) - end if - lambda = pi*((abs(lambda)/pi) - 2*ceiling(((abs(lambda)/pi)-1)/2)) * saz - end if + associate(pi => MAPL_PI_R8) + if (phi0 >= pi/2-epsilone) az = pi ! starting at north pole + if (phi0 <= epsilone-pi/2) az = 0 ! starting at south pole + ! Calculate coordinates of great circle end point using spherical trig. + phi = asin(sin(phi0)*cos(rng) + cos(phi0)*sin(rng)*cos(az)) + lambda = lambda0 + atan2( sin(rng)*sin(az), & + cos(phi0)*cos(rng) - sin(phi0)*sin(rng)*cos(az) ) + + + if (wrapon) then + if ( lambda>-epsilone .AND. lambda < epsilone) then + saz = 0 + else + saz = lambda/abs(lambda) + end if + lambda = pi*((abs(lambda)/pi) - 2*ceiling(((abs(lambda)/pi)-1)/2)) * saz + end if + end associate lambda = rad2deg(lambda) phi = rad2deg(phi) @@ -1060,7 +1049,7 @@ SUBROUTINE find_LTGE(distlon, lat_vec_centers, vec_lat, long_limits) do k=1,mys if ( (lat_vec_centers(k).LT.vec_lat(i)).AND. & (lat_vec_centers(k).GE.vec_lat(i+1)) ) then - long_limitstemp(i) = cdeg2km * distlon(k) + long_limitstemp(i) = MAPL_DEG_PER_KM * distlon(k) exit end if end do @@ -1204,7 +1193,7 @@ REAL(dp) FUNCTION find_delta_t(iSat, kk, long_limits, longind,t1,time_day) END DO long_wayptemp = (long_wayptemp-180) flag_add = 0 - dista = cdeg2km * get_distance( lat_wayptemp(1,1),long_wayptemp(1,1), & + dista = MAPL_DEG_PER_KM * get_distance( lat_wayptemp(1,1),long_wayptemp(1,1), & lat_wayptemp(2,1),long_wayptemp(2,1)) if (dista.GT.long_limits) then flag_add = 1 diff --git a/base/MAPL_OrbGridCompMod.F90 b/base/MAPL_OrbGridCompMod.F90 index 88710c1314bd..35c07ac8d66c 100644 --- a/base/MAPL_OrbGridCompMod.F90 +++ b/base/MAPL_OrbGridCompMod.F90 @@ -16,6 +16,7 @@ MODULE MAPL_OrbGridCompMod ! Use ESMF Use MAPL_Mod + Use MAPL_Constants IMPLICIT NONE PRIVATE @@ -993,7 +994,7 @@ subroutine orb_swath_mask_xy(mask,im,jm,x,y,slons,slats,nobs,isegs,jsegs,lb,ub,f real, pointer :: ex(:), ey(:) real(dp) :: slons(3,nobs), slats(3,nobs) - real(dp) :: alpha, beta, d2r, r2d, lon1, lon2, lat1, lat2 + real(dp) :: alpha, beta, lon1, lon2, lat1, lat2 integer, intent(out) :: mask(im,jm) real :: x_loc, y_loc @@ -1009,8 +1010,6 @@ subroutine orb_swath_mask_xy(mask,im,jm,x,y,slons,slats,nobs,isegs,jsegs,lb,ub,f integer :: face_pnt logical :: switch - d2r = MAPL_PI/180. - r2d = 180./MAPL_PI ! find indices have constant values of coordinate switch = .false. if ( abs(x(1,1)-x(2,1)) < abs(x(1,1)-x(1,2)) ) switch = .true. @@ -1070,79 +1069,81 @@ subroutine orb_swath_mask_xy(mask,im,jm,x,y,slons,slats,nobs,isegs,jsegs,lb,ub,f endif ! interpolate along great circle unless endpoints of interpolation have same lon - eplatl1 = slats(1,n-1) - eplatr1 = slats(3,n-1) - eplatl2 = slats(1,n) - eplatr2 = slats(3,n) - sdnom1 = sin((eplonl1-eplonr1)*d2r) - sdnom2 = sin((eplonl2-eplonr2)*d2r) - if (abs(sdnom1) /= 0.) then - sp1 = sin((lon1-eplonr1)*d2r)/sdnom1 - sp2 = sin((lon1-eplonl1)*d2r)/sdnom1 - lat1 = atan(tan(eplatl1*d2r)*sp1 - tan(eplatr1*d2r)*sp2) - lat1 = lat1*r2d - else - lat1 = (1.0-alpha) * slats(1,n-1) + alpha * slats(3,n-1) - endif - if (abs(sdnom2) /= 0.) then - sp1 = sin((lon2-eplonr2)*d2r)/sdnom2 - sp2 = sin((lon2-eplonl2)*d2r)/sdnom2 - lat2 = atan(tan(eplatl2*d2r)*sp1 - tan(eplatr2*d2r)*sp2) - lat2 = lat2*r2d - else - lat2 = (1.0-alpha) * slats(1,n) + alpha * slats(3,n) - endif + associate(d2r => MAPL_DEGREES_TO_RADIANS_R8, r2d => MAPL_RADIANS_TO_DEGREES) + eplatl1 = slats(1,n-1) + eplatr1 = slats(3,n-1) + eplatl2 = slats(1,n) + eplatr2 = slats(3,n) + sdnom1 = sin((eplonl1-eplonr1)*d2r) + sdnom2 = sin((eplonl2-eplonr2)*d2r) + if (abs(sdnom1) /= 0.) then + sp1 = sin((lon1-eplonr1)*d2r)/sdnom1 + sp2 = sin((lon1-eplonl1)*d2r)/sdnom1 + lat1 = atan(tan(eplatl1*d2r)*sp1 - tan(eplatr1*d2r)*sp2) + lat1 = lat1*r2d + else + lat1 = (1.0-alpha) * slats(1,n-1) + alpha * slats(3,n-1) + endif + if (abs(sdnom2) /= 0.) then + sp1 = sin((lon2-eplonr2)*d2r)/sdnom2 + sp2 = sin((lon2-eplonl2)*d2r)/sdnom2 + lat2 = atan(tan(eplatl2*d2r)*sp1 - tan(eplatr2*d2r)*sp2) + lat2 = lat2*r2d + else + lat2 = (1.0-alpha) * slats(1,n) + alpha * slats(3,n) + endif - do m = 1, jsegs ! along track refinement - beta = (m - 1.0 ) / ( jsegs - 1.0 ) - if (abs(lon2-lon1) < 180.) then - lon = (1.0-beta) * lon1 + beta * lon2 - eplon1=lon1 - eplon2=lon2 - else if (lon2 > lon1) then - lon = (1.0-beta) * (lon1+360.) + beta * lon2 - eplon1=lon1+360. - eplon2=lon2 - else - lon = (1.0-beta) * lon1 + beta * (lon2+360.) - eplon1=lon1 - eplon2=lon2+360. - endif - eplat1=lat1 - eplat2=lat2 - sdnom=sin((eplon1-eplon2)*d2r) - if (abs(sdnom) /= 0. ) then - sp1=sin((lon-eplon2)*d2r)/sdnom - sp2=sin((lon-eplon1)*d2r)/sdnom - latf = atan(tan(eplat1*d2r)*sp1-tan(eplat2*d2r)*sp2) - latf = latf*r2d - lat = latf - else - lat = (1.0-beta) * lat1 + beta * lat2 - endif - if (lon < lb) lon=lon+360. - if (lon > ub) lon=lon-360. - - lat = lat * MAPL_PI/180.0 - lon = lon * MAPL_PI/180.0 - call check_face_pnt(LON,LAT,face_pnt) - if (face_pnt == face) then - call cube_xy_point(x_loc,y_loc,LAT,LON,face) - inbox = pnt_in_rect(x_loc,y_loc,wcorner_x,wcorner_y) - if (inbox == 1) then - i = ijsearch(ex,im_1d,x_loc,.false.) - j = ijsearch(ey,jm_1d,y_loc,.false.) - if (switch) then - itmp = i - i = j - j = itmp - endif - if ( i>0 .and. j>0 .and. i<=im .and. j<=jm) then - mask(i,j)=1 + do m = 1, jsegs ! along track refinement + beta = (m - 1.0 ) / ( jsegs - 1.0 ) + if (abs(lon2-lon1) < 180.) then + lon = (1.0-beta) * lon1 + beta * lon2 + eplon1=lon1 + eplon2=lon2 + else if (lon2 > lon1) then + lon = (1.0-beta) * (lon1+360.) + beta * lon2 + eplon1=lon1+360. + eplon2=lon2 + else + lon = (1.0-beta) * lon1 + beta * (lon2+360.) + eplon1=lon1 + eplon2=lon2+360. + endif + eplat1=lat1 + eplat2=lat2 + sdnom=sin((eplon1-eplon2)*d2r) + if (abs(sdnom) /= 0. ) then + sp1=sin((lon-eplon2)*d2r)/sdnom + sp2=sin((lon-eplon1)*d2r)/sdnom + latf = atan(tan(eplat1*d2r)*sp1-tan(eplat2*d2r)*sp2) + latf = latf*r2d + lat = latf + else + lat = (1.0-beta) * lat1 + beta * lat2 + endif + if (lon < lb) lon=lon+360. + if (lon > ub) lon=lon-360. + + lat = lat * MAPL_PI/180.0 + lon = lon * MAPL_PI/180.0 + call check_face_pnt(LON,LAT,face_pnt) + if (face_pnt == face) then + call cube_xy_point(x_loc,y_loc,LAT,LON,face) + inbox = pnt_in_rect(x_loc,y_loc,wcorner_x,wcorner_y) + if (inbox == 1) then + i = ijsearch(ex,im_1d,x_loc,.false.) + j = ijsearch(ey,jm_1d,y_loc,.false.) + if (switch) then + itmp = i + i = j + j = itmp + endif + if ( i>0 .and. j>0 .and. i<=im .and. j<=jm) then + mask(i,j)=1 + end if end if - end if - endif - end do ! msegs + endif + end do ! msegs + end associate end do ! nobs end do ! ksegs @@ -1163,7 +1164,7 @@ subroutine orb_swath_mask_lonlat(mask,im,jm,lons,lats,slons,slats,nobs,isegs,jse real :: lons_1d(im),lats_1d(jm) real :: elons(im+1), elats(jm+1) real(dp) :: slons(3,nobs), slats(3,nobs) - real(dp) :: alpha, beta, d2r, r2d, lon1, lon2, lat1, lat2 + real(dp) :: alpha, beta, lon1, lon2, lat1, lat2 integer, intent(out) :: mask(im,jm) @@ -1176,8 +1177,6 @@ subroutine orb_swath_mask_lonlat(mask,im,jm,lons,lats,slons,slats,nobs,isegs,jse real :: sdnom,eplon1,eplon2,eplat1,eplat2 real :: latf - d2r = MAPL_PI/180. - r2d = 180./MAPL_PI ! Build edge coords ! ----------------- @@ -1227,65 +1226,67 @@ subroutine orb_swath_mask_lonlat(mask,im,jm,lons,lats,slons,slats,nobs,isegs,jse endif ! interpolate along great circle unless endpoints of interpolation have same lon - eplatl1 = slats(1,n-1) - eplatr1 = slats(3,n-1) - eplatl2 = slats(1,n) - eplatr2 = slats(3,n) - sdnom1 = sin((eplonl1-eplonr1)*d2r) - sdnom2 = sin((eplonl2-eplonr2)*d2r) - if (abs(sdnom1) /= 0.) then - sp1 = sin((lon1-eplonr1)*d2r)/sdnom1 - sp2 = sin((lon1-eplonl1)*d2r)/sdnom1 - lat1 = atan(tan(eplatl1*d2r)*sp1 - tan(eplatr1*d2r)*sp2) - lat1 = lat1*r2d - else - lat1 = (1.0-alpha) * slats(1,n-1) + alpha * slats(3,n-1) - endif - if (abs(sdnom2) /= 0.) then - sp1 = sin((lon2-eplonr2)*d2r)/sdnom2 - sp2 = sin((lon2-eplonl2)*d2r)/sdnom2 - lat2 = atan(tan(eplatl2*d2r)*sp1 - tan(eplatr2*d2r)*sp2) - lat2 = lat2*r2d - else - lat2 = (1.0-alpha) * slats(1,n) + alpha * slats(3,n) - endif + associate(d2r => MAPL_DEGREES_TO_RADIANS_R8, r2d => MAPL_RADIANS_TO_DEGREES) + eplatl1 = slats(1,n-1) + eplatr1 = slats(3,n-1) + eplatl2 = slats(1,n) + eplatr2 = slats(3,n) + sdnom1 = sin((eplonl1-eplonr1)*d2r) + sdnom2 = sin((eplonl2-eplonr2)*d2r) + if (abs(sdnom1) /= 0.) then + sp1 = sin((lon1-eplonr1)*d2r)/sdnom1 + sp2 = sin((lon1-eplonl1)*d2r)/sdnom1 + lat1 = atan(tan(eplatl1*d2r)*sp1 - tan(eplatr1*d2r)*sp2) + lat1 = lat1*r2d + else + lat1 = (1.0-alpha) * slats(1,n-1) + alpha * slats(3,n-1) + endif + if (abs(sdnom2) /= 0.) then + sp1 = sin((lon2-eplonr2)*d2r)/sdnom2 + sp2 = sin((lon2-eplonl2)*d2r)/sdnom2 + lat2 = atan(tan(eplatl2*d2r)*sp1 - tan(eplatr2*d2r)*sp2) + lat2 = lat2*r2d + else + lat2 = (1.0-alpha) * slats(1,n) + alpha * slats(3,n) + endif - do m = 1, jsegs ! along track refinement - beta = (m - 1.0 ) / ( jsegs - 1.0 ) - if (abs(lon2-lon1) < 180.) then - lon = (1.0-beta) * lon1 + beta * lon2 - eplon1=lon1 - eplon2=lon2 - else if (lon2 > lon1) then - lon = (1.0-beta) * (lon1+360.) + beta * lon2 - eplon1=lon1+360. - eplon2=lon2 - else - lon = (1.0-beta) * lon1 + beta * (lon2+360.) - eplon1=lon1 - eplon2=lon2+360. - endif - eplat1=lat1 - eplat2=lat2 - sdnom=sin((eplon1-eplon2)*d2r) - if (abs(sdnom) /= 0. ) then - sp1=sin((lon-eplon2)*d2r)/sdnom - sp2=sin((lon-eplon1)*d2r)/sdnom - latf = atan(tan(eplat1*d2r)*sp1-tan(eplat2*d2r)*sp2) - latf = latf*r2d - lat = latf - else - lat = (1.0-beta) * lat1 + beta * lat2 - endif - if (lon < lb) lon=lon+360. - if (lon > ub) lon=lon-360. - inbox = pnt_in_rect(lat,lon,wcorner_lat,wcorner_lon) - if (inbox == 1) then - i = ijsearch(elons,im+1,lon,.false.) - j = ijsearch(elats,jm+1,lat,.false.) - if ( i>0 .and. i<=im .and. j>0 .and. j<=jm ) mask(i,j) = 1 - end if - end do ! msegs + do m = 1, jsegs ! along track refinement + beta = (m - 1.0 ) / ( jsegs - 1.0 ) + if (abs(lon2-lon1) < 180.) then + lon = (1.0-beta) * lon1 + beta * lon2 + eplon1=lon1 + eplon2=lon2 + else if (lon2 > lon1) then + lon = (1.0-beta) * (lon1+360.) + beta * lon2 + eplon1=lon1+360. + eplon2=lon2 + else + lon = (1.0-beta) * lon1 + beta * (lon2+360.) + eplon1=lon1 + eplon2=lon2+360. + endif + eplat1=lat1 + eplat2=lat2 + sdnom=sin((eplon1-eplon2)*d2r) + if (abs(sdnom) /= 0. ) then + sp1=sin((lon-eplon2)*d2r)/sdnom + sp2=sin((lon-eplon1)*d2r)/sdnom + latf = atan(tan(eplat1*d2r)*sp1-tan(eplat2*d2r)*sp2) + latf = latf*r2d + lat = latf + else + lat = (1.0-beta) * lat1 + beta * lat2 + endif + if (lon < lb) lon=lon+360. + if (lon > ub) lon=lon-360. + inbox = pnt_in_rect(lat,lon,wcorner_lat,wcorner_lon) + if (inbox == 1) then + i = ijsearch(elons,im+1,lon,.false.) + j = ijsearch(elats,jm+1,lat,.false.) + if ( i>0 .and. i<=im .and. j>0 .and. j<=jm ) mask(i,j) = 1 + end if + end do ! msegs + end associate end do ! nobs end do ! ksegs end subroutine orb_swath_mask_lonlat diff --git a/base/MAPL_Profiler.F90 b/base/MAPL_Profiler.F90 index e160fc9210f1..73697688c0d2 100644 --- a/base/MAPL_Profiler.F90 +++ b/base/MAPL_Profiler.F90 @@ -18,6 +18,7 @@ module MAPL_ProfMod use MAPL_IOMod use MAPL_CommsMod use MAPL_ExceptionHandling + use MAPL_Constants #ifdef _CUDA use cudafor #endif @@ -47,11 +48,6 @@ module MAPL_ProfMod !EOP - integer, public, parameter :: MAPL_TimerModeOld = 0 - integer, public, parameter :: MAPL_TimerModeRootOnly = 1 - integer, public, parameter :: MAPL_TimerModeMax = 2 - integer, public, parameter :: MAPL_TimerModeMinMax = 3 - type(ESMF_VM), save :: VM integer(kind=INT64), save :: COUNT_MAX, COUNT_RATE real(kind=REAL64), save :: CRI diff --git a/base/MAPL_SatVapor.F90 b/base/MAPL_SatVapor.F90 index e52e4aff01c3..db9d1a55637a 100644 --- a/base/MAPL_SatVapor.F90 +++ b/base/MAPL_SatVapor.F90 @@ -5,7 +5,7 @@ module MAPL_SatVaporMod #ifdef MAPL_MODE - use MAPL_ConstantsMod + use MAPL_Constants #endif use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 @@ -30,7 +30,7 @@ module MAPL_SatVaporMod ! !USES: ! -! use MAPL_ConstantsMod +! use MAPL_Constants ! implicit none private @@ -45,11 +45,6 @@ module MAPL_SatVaporMod ! ! !PUBLIC DATA MEMBERS: ! -! Enumeration values for the saturation vapor pressure formulation to be used. - - public MAPL_UseStarrQsat - public MAPL_UseGoffGratchQsat - public MAPL_UseMurphyKoopQsat ! !FILES USED: ! @@ -160,9 +155,6 @@ module MAPL_SatVaporMod integer, parameter :: GoffGratch = 2 integer, parameter :: MurphyKoop = 3 - integer, parameter :: MAPL_UseStarrQsat = Starr - integer, parameter :: MAPL_UseGoffGratchQsat = GoffGratch - integer, parameter :: MAPL_UseMurphyKoopQsat = MurphyKoop ! Tables and other Global variables diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index fc9ea5bc013a..0c27e5ad715c 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -27,7 +27,7 @@ module MAPL_SimpleBundleMod use MAPL_CFIOMod use MAPL_MaxMinMod use MAPL_CommsMod, only: MAPL_AM_I_ROOT - use MAPL_ConstantsMod, only: MAPL_PI + use MAPL_Constants, only: MAPL_PI use MAPL_ExceptionHandling implicit NONE @@ -105,8 +105,6 @@ module MAPL_SimpleBundleMod !EOP !---------------------------------------------------------------------------- - integer, parameter :: READ_ONLY=1 - interface MAPL_SimpleBundleWrite module procedure MAPL_SimpleBundleWrite1 module procedure MAPL_SimpleBundleWrite2 diff --git a/base/MAPL_SphericalGeometry.F90 b/base/MAPL_SphericalGeometry.F90 index ed80361f9d6d..8cadc85c3d18 100644 --- a/base/MAPL_SphericalGeometry.F90 +++ b/base/MAPL_SphericalGeometry.F90 @@ -3,7 +3,7 @@ module MAPL_SphericalGeometry use MAPL_KeywordEnforcerMod use mapl_ErrorHandlingMod use ESMF - use MAPL_ConstantsMod + use MAPL_Constants use, intrinsic :: iso_fortran_env, only: REAL64,REAL32 implicit none diff --git a/base/MAPL_TilingRegridder.F90 b/base/MAPL_TilingRegridder.F90 index 9dccc234a6c9..da319cbb420e 100644 --- a/base/MAPL_TilingRegridder.F90 +++ b/base/MAPL_TilingRegridder.F90 @@ -8,8 +8,9 @@ module MAPL_TilingRegridderMod use MAPL_RegridderSpec use MAPL_RegridMethods use MAPL_DirPathMod - use MAPL_BaseMod, only: MAPL_UNDEF, MAPL_TileNameLength + use MAPL_BaseMod, only: MAPL_UNDEF use MAPL_ShmemMod + use MAPL_Constants use Regrid_Functions_Mod, only: readTileFileNC_file use ESMF use gFTL_IntegerVector diff --git a/base/MAPL_TripolarGridFactory.F90 b/base/MAPL_TripolarGridFactory.F90 index 783dd40b3b00..c65cfe08389e 100644 --- a/base/MAPL_TripolarGridFactory.F90 +++ b/base/MAPL_TripolarGridFactory.F90 @@ -7,6 +7,7 @@ module MAPL_TripolarGridFactoryMod use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_ShmemMod + use MAPL_Constants use ESMF use pFIO use, intrinsic :: iso_fortran_env, only: REAL32 @@ -17,23 +18,18 @@ module MAPL_TripolarGridFactoryMod public :: TripolarGridFactory integer, parameter :: NUM_DIM = 2 - integer, parameter :: UNDEFINED_INTEGER = 1-huge(1) - character(len=*), parameter :: UNDEFINED_CHAR = '**' - - character(len=*), parameter :: GRID_NAME_DEFAULT = 'UNKNOWN' - character(len=*), parameter :: GRID_FILE_NAME_DEFAULT = 'UNKNOWN' type, extends(AbstractGridFactory) :: TripolarGridFactory private character(len=:), allocatable :: grid_file_name character(len=:), allocatable :: grid_name ! Grid dimensions - integer :: im_world = UNDEFINED_INTEGER - integer :: jm_world = UNDEFINED_INTEGER + integer :: im_world = MAPL_UNDEFINED_INTEGER + integer :: jm_world = MAPL_UNDEFINED_INTEGER integer :: lm ! Domain decomposition: - integer :: nx = UNDEFINED_INTEGER - integer :: ny = UNDEFINED_INTEGER + integer :: nx = MAPL_UNDEFINED_INTEGER + integer :: ny = MAPL_UNDEFINED_INTEGER integer, allocatable :: ims(:) integer, allocatable :: jms(:) ! Used for halo @@ -107,14 +103,14 @@ function TripolarGridFactory_from_parameters(unusable, grid_file_name, grid_name if (present(unusable)) print*,shape(unusable) - call set_with_default(factory%grid_name, grid_name, GRID_NAME_DEFAULT) - call set_with_default(factory%grid_file_name, grid_file_name, GRID_FILE_NAME_DEFAULT) + call set_with_default(factory%grid_name, grid_name, MAPL_GRID_NAME_DEFAULT) + call set_with_default(factory%grid_file_name, grid_file_name, MAPL_GRID_FILE_NAME_DEFAULT) - call set_with_default(factory%ny, nx, UNDEFINED_INTEGER) - call set_with_default(factory%nx, ny, UNDEFINED_INTEGER) - call set_with_default(factory%im_world, im_world, UNDEFINED_INTEGER) - call set_with_default(factory%jm_world, jm_world, UNDEFINED_INTEGER) - call set_with_default(factory%lm, lm, UNDEFINED_INTEGER) + call set_with_default(factory%ny, nx, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%nx, ny, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%im_world, im_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%jm_world, jm_world, MAPL_UNDEFINED_INTEGER) + call set_with_default(factory%lm, lm, MAPL_UNDEFINED_INTEGER) @@ -180,7 +176,7 @@ function create_basic_grid(this, unusable, rc) result(grid) call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=status) _VERIFY(status) - if (this%lm /= UNDEFINED_INTEGER) then + if (this%lm /= MAPL_UNDEFINED_INTEGER) then call ESMF_AttributeSet(grid, name='GRID_LM', value=this%lm, rc=status) _VERIFY(status) end if @@ -196,7 +192,7 @@ subroutine add_horz_coordinates(this, grid, unusable, rc) use MAPL_CommsMod use MAPL_IOMod use NetCDF - use MAPL_ConstantsMod + use MAPL_Constants class (TripolarGridFactory), intent(in) :: this type (ESMF_Grid), intent(inout) :: grid class (KeywordEnforcer), optional, intent(in) :: unusable @@ -364,18 +360,18 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc if (present(unusable)) print*,shape(unusable) - call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=GRID_NAME_DEFAULT) + call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=MAPL_GRID_NAME_DEFAULT) this%grid_name = trim(tmp) call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDSPEC:', rc=status) _VERIFY(status) this%grid_file_name = trim(tmp) - call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=UNDEFINED_INTEGER) - call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%nx, label=prefix//'NX:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%ny, label=prefix//'NY:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%im_world, label=prefix//'IM_WORLD:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%jm_world, label=prefix//'JM_WORLD:', default=MAPL_UNDEFINED_INTEGER) + call ESMF_ConfigGetAttribute(config, this%lm, label=prefix//'LM:', default=MAPL_UNDEFINED_INTEGER) call this%check_and_fill_consistency(rc=status) @@ -454,7 +450,7 @@ subroutine check_and_fill_consistency(this, unusable, rc) _UNUSED_DUMMY(unusable) if (.not. allocated(this%grid_name)) then - this%grid_name = GRID_NAME_DEFAULT + this%grid_name = MAPL_GRID_NAME_DEFAULT end if ! Check decomposition/bounds @@ -483,13 +479,13 @@ subroutine verify(n, m_world, ms, rc) if (allocated(ms)) then _ASSERT(size(ms) > 0,"needs message") - if (n == UNDEFINED_INTEGER) then + if (n == MAPL_UNDEFINED_INTEGER) then n = size(ms) else _ASSERT(n == size(ms),"needs message") end if - if (m_world == UNDEFINED_INTEGER) then + if (m_world == MAPL_UNDEFINED_INTEGER) then m_world = sum(ms) else _ASSERT(m_world == sum(ms),"needs message") @@ -497,8 +493,8 @@ subroutine verify(n, m_world, ms, rc) else - _ASSERT(n /= UNDEFINED_INTEGER,"needs message") - _ASSERT(m_world /= UNDEFINED_INTEGER,"needs message") + _ASSERT(n /= MAPL_UNDEFINED_INTEGER,"needs message") + _ASSERT(m_world /= MAPL_UNDEFINED_INTEGER,"needs message") allocate(ms(n), stat=status) _VERIFY(status) call MAPL_DecomposeDim(m_world, ms, n) @@ -545,7 +541,7 @@ end subroutine set_with_default_character ! input files. subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) use MAPL_ConfigMod - use MAPL_ConstantsMod, only: PI => MAPL_PI_R8 + use MAPL_Constants, only: PI => MAPL_PI_R8 class (TripolarGridFactory), intent(inout) :: this type (ESMF_DistGrid), intent(in) :: dist_grid type (ESMF_LocalArray), intent(in) :: lon_array diff --git a/base/MAPL_VerticalInterpMod.F90 b/base/MAPL_VerticalInterpMod.F90 index 4bcb863d3c7f..deb2bcd3eca3 100644 --- a/base/MAPL_VerticalInterpMod.F90 +++ b/base/MAPL_VerticalInterpMod.F90 @@ -8,7 +8,7 @@ module linearVerticalInterpolation_mod use ESMF use MAPL_BaseMod - use MAPL_ConstantsMod, only: MAPL_KAPPA, MAPL_RGAS, MAPL_CP, MAPL_GRAV + use MAPL_Constants, only: MAPL_KAPPA, MAPL_RGAS, MAPL_CP, MAPL_GRAV use MAPL_ExceptionHandling use, intrinsic :: iso_fortran_env, only: REAL64 ! diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 36c4787f4c14..997d593b9c11 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -16,16 +16,19 @@ module MAPL_VerticalDataMod public :: VERTICAL_METHOD_NONE public :: VERTICAL_METHOD_SELECT public :: VERTICAL_METHOD_ETA2LEV + public :: VERTICAL_METHOD_FLIP enum, bind(c) enumerator :: VERTICAL_METHOD_NONE = -1 enumerator :: VERTICAL_METHOD_SELECT enumerator :: VERTICAL_METHOD_ETA2LEV + enumerator :: VERTICAL_METHOD_FLIP end enum type, public :: verticalData character(len=:), allocatable :: vunit character(len=:), allocatable :: func character(len=:), allocatable :: vvar + character(len=:), allocatable :: positive real :: vscale real :: pow=0.0 real, allocatable :: levs(:) @@ -46,6 +49,7 @@ module MAPL_VerticalDataMod procedure :: skip_var procedure :: correct_topo procedure :: setup_eta_to_pressure + procedure :: flip_levels end type verticalData interface verticalData @@ -54,16 +58,29 @@ module MAPL_VerticalDataMod contains - function newVerticalData(levels,vcoord,vscale,vunit,rc) result(vdata) + function newVerticalData(levels,vcoord,vscale,vunit,positive,rc) result(vdata) type(VerticalData) :: vData real, pointer, intent(in), optional :: levels(:) real, intent(in), optional :: vscale character(len=*), optional, intent(in) :: vcoord character(len=*), optional, intent(in) :: vunit + character(len=*), optional, intent(in) :: positive integer, optional, intent(Out) :: rc + + + if (present(positive)) then + _ASSERT(trim(positive)=='up'.or.trim(positive)=='down',trim(positive)//" not allowed for positive argument") + vdata%positive=trim(positive) + else + vdata%positive='down' + end if if (.not.present(levels)) then - vdata%regrid_type = VERTICAL_METHOD_NONE + if (trim(vdata%positive)=='down') then + vdata%regrid_type = VERTICAL_METHOD_NONE + else + vdata%regrid_type = VERTICAL_METHOD_FLIP + end if _RETURN(ESMF_SUCCESS) end if @@ -212,10 +229,27 @@ subroutine regrid_eta_to_pressure(this,ptrin,ptrout,rc) call vertinterp(ptrout(:,:,k),ptrin,this%interp_levels(k),this%ple3d,this%pl3d,rc=status) _VERIFY(status) end do - + _RETURN(_SUCCESS) end subroutine regrid_eta_to_pressure + subroutine flip_levels(this,ptrin,ptrout,rc) + class(verticaldata), intent(inout) :: this + real, intent(inout) :: ptrin(:,:,:) + real, intent(inout) :: ptrout(:,:,:) + integer, optional, intent(out) :: rc + + integer :: km + + _ASSERT(all(shape(ptrin)==shape(ptrout)),"array must match shape to flip") + + km = size(ptrin,3) + + ptrout(:,:,1:km)=ptrin(:,:,km:1:-1) + _RETURN(_SUCCESS) + + end subroutine flip_levels + subroutine correct_topo(this,field,rc) class(verticalData), intent(inout) :: this type(ESMF_Field), intent(inout) :: field @@ -414,7 +448,7 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) if (haveVert) then this%lm=lm - if (this%regrid_type == VERTICAL_METHOD_NONE) then + if (this%regrid_type == VERTICAL_METHOD_NONE .or. this%regrid_type == VERTICAL_METHOD_FLIP) then if (.not.allocated(this%levs)) then allocate(this%levs(lm)) do i=1,lm @@ -433,16 +467,18 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) call v%add_attribute('coordinate','N/A') call v%add_const_value(UnlimitedEntity(this%levs)) call metadata%add_variable('lev',v,rc=status) + _VERIFY(status) else call metadata%add_dimension('lev', lm, rc=status) v = Variable(type=PFIO_REAL64, dimensions='lev') call v%add_attribute('long_name','vertical level') call v%add_attribute('units','layer') - call v%add_attribute('positive','down') + call v%add_attribute('positive',trim(this%positive)) call v%add_attribute('coordinate','eta') call v%add_attribute('standard_name','model_layer') call v%add_const_value(UnlimitedEntity(this%levs)) call metadata%add_variable('lev',v,rc=status) + _VERIFY(status) end if else if (this%regrid_type == VERTICAL_METHOD_ETA2LEV) then @@ -459,6 +495,7 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) call v%add_attribute('standard_name',trim(this%vvar)//"_level") call v%add_const_value(UnlimitedEntity(this%levs)) call metadata%add_variable('lev',v,rc=status) + _VERIFY(status) else if (this%regrid_type == VERTICAL_METHOD_SELECT) then call metadata%add_dimension('lev', lm, rc=status) @@ -470,6 +507,7 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) call v%add_attribute('standard_name','model_layer') call v%add_const_value(UnlimitedEntity(this%levs)) call metadata%add_variable('lev',v,rc=status) + _VERIFY(status) end if end if _RETURN(_SUCCESS) diff --git a/base/MAPL_VotingRegridder.F90 b/base/MAPL_VotingRegridder.F90 index 8998b7d57570..5075fcced173 100644 --- a/base/MAPL_VotingRegridder.F90 +++ b/base/MAPL_VotingRegridder.F90 @@ -3,6 +3,7 @@ module MAPL_VotingRegridderMod use MAPL_AbstractRegridderMod use MAPL_TilingRegridderMod use MAPL_BaseMod, only: MAPL_UNDEF + use MAPL_Constants use ESMF use, intrinsic :: iso_fortran_env, only: REAL32 implicit none diff --git a/base/MAPL_newCFIO.F90 b/base/MAPL_newCFIO.F90 index b8ff2abc58f7..b680e67d3726 100644 --- a/base/MAPL_newCFIO.F90 +++ b/base/MAPL_newCFIO.F90 @@ -12,7 +12,7 @@ module MAPL_newCFIOMod use MAPL_RegridMethods use MAPL_TimeDataMod use MAPL_VerticalDataMod - use MAPL_ConstantsMod + use MAPL_Constants use pFIO use MAPL_newCFIOItemVectorMod use MAPL_newCFIOItemMod @@ -295,7 +295,8 @@ subroutine CreateVariable(this,itemName,rc) call v%add_attribute('_FillValue',MAPL_UNDEF) call v%add_attribute('valid_range',(/-MAPL_UNDEF,MAPL_UNDEF/)) call factory%append_variable_metadata(v) - call this%metadata%add_variable(trim(varName),v) + call this%metadata%add_variable(trim(varName),v,rc=status) + _VERIFY(status) ! finally make a new field if neccessary if (this%doVertRegrid .and. (fieldRank ==3) ) then newField = MAPL_FieldCreate(field,this%output_grid,lm=this%vData%lm,rc=status) @@ -460,6 +461,9 @@ subroutine RegridScalar(this,itemName,rc) else if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then call this%vdata%regrid_eta_to_pressure(ptr3d,ptr3d_inter,rc=status) _VERIFY(status) + else if (this%vdata%regrid_type==VERTICAL_METHOD_FLIP) then + call this%vdata%flip_levels(ptr3d,ptr3d_inter,rc=status) + _VERIFY(status) end if ptr3d => ptr3d_inter end if @@ -574,6 +578,9 @@ subroutine RegridVector(this,xName,yName,rc) else if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then call this%vdata%regrid_eta_to_pressure(xptr3d,xptr3d_inter,rc=status) _VERIFY(status) + else if (this%vdata%regrid_type==VERTICAL_METHOD_FLIP) then + call this%vdata%flip_levels(xptr3d,xptr3d_inter,rc=status) + _VERIFY(status) end if xptr3d => xptr3d_inter end if @@ -596,6 +603,9 @@ subroutine RegridVector(this,xName,yName,rc) else if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then call this%vdata%regrid_eta_to_pressure(yptr3d,yptr3d_inter,rc=status) _VERIFY(status) + else if (this%vdata%regrid_type==VERTICAL_METHOD_FLIP) then + call this%vdata%flip_levels(yptr3d,yptr3d_inter,rc=status) + _VERIFY(status) end if yptr3d => yptr3d_inter end if diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 41b225120430..72c18abd4312 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -19,7 +19,7 @@ module MAPL_SunMod ! !USES: use ESMF - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_BaseMod use MAPL_IOMod use MAPL_CommsMod @@ -521,7 +521,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE real(kind=REAL64) :: TREL, T1, T2, T3, T4, dTRELdDAY real(kind=REAL64) :: SOB, COB, OMG0, OMG, PRH, PRHV - real :: D2R, OMECC, OPECC, OMSQECC, EAFAC + real :: OMECC, OPECC, OMSQECC, EAFAC real(kind=REAL64) :: TA, EA, MA, TRRA, MNRA real :: meanEOT type(MAPL_SunOrbit) :: ORBIT @@ -537,8 +537,6 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! where TREL is ecliptic longitude of true Sun dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 - ! useful constants - D2R = MAPL_PI / 180. ! record inputs needed by both orbit methods ORBIT%CLOCK = CLOCK @@ -549,13 +547,15 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & if (ORBIT_ANAL2B) then ! record inputs in ORBIT type - ORBIT%ORB2B_YEARLEN = ORB2B_YEARLEN - ORBIT%ORB2B_ECC_REF = ORB2B_ECC_REF - ORBIT%ORB2B_OBQ_REF = ORB2B_OBQ_REF * D2R ! radians - ORBIT%ORB2B_LAMBDAP_REF = ORB2B_LAMBDAP_REF * D2R ! radians - ORBIT%ORB2B_ECC_RATE = ORB2B_ECC_RATE / 36525. ! per day - ORBIT%ORB2B_OBQ_RATE = ORB2B_OBQ_RATE * D2R / 36525. ! radians per day - ORBIT%ORB2B_LAMBDAP_RATE = ORB2B_LAMBDAP_RATE * D2R / 36525. ! radians per day + associate(D2R => MAPL_DEGREES_TO_RADIANS) + ORBIT%ORB2B_YEARLEN = ORB2B_YEARLEN + ORBIT%ORB2B_ECC_REF = ORB2B_ECC_REF + ORBIT%ORB2B_OBQ_REF = ORB2B_OBQ_REF * D2R ! radians + ORBIT%ORB2B_LAMBDAP_REF = ORB2B_LAMBDAP_REF * D2R ! radians + ORBIT%ORB2B_ECC_RATE = ORB2B_ECC_RATE / 36525. ! per day + ORBIT%ORB2B_OBQ_RATE = ORB2B_OBQ_RATE * D2R / 36525. ! radians per day + ORBIT%ORB2B_LAMBDAP_RATE = ORB2B_LAMBDAP_RATE * D2R / 36525. ! radians per day + end associate ! record MAPL Time object for REFerence time year = ORB2B_REF_YYYYMMDD / 10000 month = mod(ORB2B_REF_YYYYMMDD, 10000) / 100 @@ -613,11 +613,13 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! OMSQECC = OMECC * OPECC EAFAC = sqrt(OMECC/OPECC) - OMG0 = 2.*MAPL_PI/YEARLEN - OMG = OMG0/sqrt(OMSQECC)**3 - PRH = PERIHELION*D2R - SOB = sin(OBLIQUITY*D2R) - COB = cos(OBLIQUITY*D2R) + associate(D2R => MAPL_DEGREES_TO_RADIANS) + OMG0 = 2.*MAPL_PI/YEARLEN + OMG = OMG0/sqrt(OMSQECC)**3 + PRH = PERIHELION*D2R + SOB = sin(OBLIQUITY*D2R) + COB = cos(OBLIQUITY*D2R) + end associate ! PRH is the ecliptic longitude of the perihelion, measured (at the Sun) ! from the autumnal equinox in the direction of the Earth`s orbital motion diff --git a/base/Regrid_Util.F90 b/base/Regrid_Util.F90 index 22b24fe8dba7..126d778caed3 100644 --- a/base/Regrid_Util.F90 +++ b/base/Regrid_Util.F90 @@ -20,7 +20,7 @@ Program ut_ReGridding use MAPL_LatLonGridFactoryMod, only: LatLonGridFactory use MAPL_CubedSphereGridFactoryMod, only: CubedSphereGridFactory use MAPL_TripolarGridFactoryMod, only: TripolarGridFactory - use MAPL_ConstantsMod, only: MAPL_PI_R8 + use MAPL_Constants, only: MAPL_PI_R8 use MAPL_ExceptionHandling use MAPL_ApplicationSupport use pFIO diff --git a/base/RegridderSpec.F90 b/base/RegridderSpec.F90 index 46c23078d039..0b7ca5ce3855 100644 --- a/base/RegridderSpec.F90 +++ b/base/RegridderSpec.F90 @@ -2,7 +2,6 @@ ! A RegridderSpec is used to indicate which subclass of regridder will be used. module mapl_RegridderSpec - use MAPL_BaseMod, only: MAPL_UNDEF use MAPL_KeywordEnforcerMod use MAPL_ErrorHandlingMod use mapl_RegridMethods diff --git a/base/RegridderTypeSpec.F90 b/base/RegridderTypeSpec.F90 index 5e8aba26cbb4..c7915bd11f8f 100644 --- a/base/RegridderTypeSpec.F90 +++ b/base/RegridderTypeSpec.F90 @@ -1,7 +1,7 @@ #include "MAPL_Generic.h" ! A RegridderSpec is used to indicate which subclass of regridder will be used. module mapl_RegridderTypeSpec - use MAPL_BaseMod, only: MAPL_UNDEF + use MAPL_Constants use MAPL_KeywordEnforcerMod use mapl_RegridMethods use ESMF diff --git a/base/cub2latlon_regridder.F90 b/base/cub2latlon_regridder.F90 index b271a77117e8..d42ad05c247f 100644 --- a/base/cub2latlon_regridder.F90 +++ b/base/cub2latlon_regridder.F90 @@ -14,7 +14,7 @@ module SupportMod use MAPL_ExceptionHandling use MAPL_BaseMod use pFIO - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_RangeMod use MAPL_StringRouteHandleMapMod use gFTL_StringVector @@ -976,7 +976,7 @@ elemental function sind(x) result(s) real(kind=REAL64), intent(in) :: x real(kind=REAL64) :: s - s = sin(x * MAPL_DEGREES_TO_RADIANS) + s = sin(x * MAPL_DEGREES_TO_RADIANS_R8) end function sind @@ -984,7 +984,7 @@ elemental function cosd(x) result(c) real(kind=REAL64), intent(in) :: x real(kind=REAL64) :: c - c = cos(x * MAPL_DEGREES_TO_RADIANS) + c = cos(x * MAPL_DEGREES_TO_RADIANS_R8) end function cosd diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 078916951f2b..2dd621e83545 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -35,7 +35,7 @@ add_pfunit_ctest(MAPL.base.tests TEST_SOURCES ${TEST_SRCS} OTHER_SOURCES ${SRCS} # LINK_LIBRARIES MAPL.base MAPL.shared MAPL.pfio base_extras MAPL.pfunit - LINK_LIBRARIES MAPL.base MAPL.shared MAPL.pfio MAPL.pfunit + LINK_LIBRARIES MAPL.base MAPL.shared MAPL.constants MAPL.pfio MAPL.pfunit EXTRA_INITIALIZE Initialize EXTRA_USE MAPL_pFUnit_Initialize MAX_PES 8 @@ -49,7 +49,7 @@ ecbuild_add_executable ( TARGET ${TESTIO} NOINSTALL SOURCES mapl_bundleio_test.F90 - LIBS MAPL.base MAPL.shared MAPL.pfio ${NETCDF_LIBRARIES} MPI::MPI_Fortran + LIBS MAPL.base MAPL.shared MAPL.constants MAPL.pfio ${NETCDF_LIBRARIES} MPI::MPI_Fortran DEFINITIONS USE_MPI) set_target_properties(${TESTIO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) diff --git a/base/tests/Test_LatLon_Corners.pf b/base/tests/Test_LatLon_Corners.pf index af8a58284fdd..23efff9ac961 100644 --- a/base/tests/Test_LatLon_Corners.pf +++ b/base/tests/Test_LatLon_Corners.pf @@ -5,9 +5,9 @@ module Test_LatLon_Corners use ESMF_TestMethod_mod use ESMF_TestParameter_mod use MAPL_LatLonGridFactoryMod - use MAPL_ConstantsMod, only: MAPL_PI_R8 - use MAPL_ConstantsMod, only: MAPL_RADIANS_TO_DEGREES - use MAPL_ConstantsMod, only: MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only: MAPL_PI_R8 + use MAPL_Constants, only: MAPL_RADIANS_TO_DEGREES + use MAPL_Constants, only: MAPL_DEGREES_TO_RADIANS_R8 use MAPL_MinMaxMod use ESMF implicit none diff --git a/base/tests/Test_LatLon_GridFactory.pf b/base/tests/Test_LatLon_GridFactory.pf index 35bc28931573..cec271b72cf0 100644 --- a/base/tests/Test_LatLon_GridFactory.pf +++ b/base/tests/Test_LatLon_GridFactory.pf @@ -6,9 +6,9 @@ module Test_LatLon_GridFactory use ESMF_TestMethod_mod use ESMF_TestParameter_mod use MAPL_LatLonGridFactoryMod - use MAPL_ConstantsMod, only: MAPL_PI_R8 - use MAPL_ConstantsMod, only: MAPL_RADIANS_TO_DEGREES - use MAPL_ConstantsMod, only: MAPL_DEGREES_TO_RADIANS + use MAPL_Constants, only: MAPL_PI_R8 + use MAPL_Constants, only: MAPL_RADIANS_TO_DEGREES + use MAPL_Constants, only: MAPL_DEGREES_TO_RADIANS_R8 use MAPL_MinMaxMod use ESMF implicit none diff --git a/base/tests/test_DirPath.pf b/base/tests/test_DirPath.pf index 865feb68f28d..534a9f3901f4 100644 --- a/base/tests/test_DirPath.pf +++ b/base/tests/test_DirPath.pf @@ -1,6 +1,7 @@ module test_DirPath use pfunit use MAPL_DirPathMod + use MAPL_Constants contains diff --git a/base/tests/utCFIO_Array.F90 b/base/tests/utCFIO_Array.F90 index 436fda13669e..8f866b0b16ca 100644 --- a/base/tests/utCFIO_Array.F90 +++ b/base/tests/utCFIO_Array.F90 @@ -10,7 +10,7 @@ Program utCFIO use MAPL_BaseMod use MAPL_CommsMod - use MAPL_ConstantsMod + use MAPL_Constants use ESMF_CfioMod use MAPL_CfioMod diff --git a/components.yaml b/components.yaml index 1cffa93fd8c3..18f63f840006 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.5.1 + tag: v3.5.3 develop: develop ecbuild: diff --git a/generic/MAPL_VarSpecMod.F90 b/generic/MAPL_VarSpecMod.F90 index 6bd263378466..07f4d41efe7d 100644 --- a/generic/MAPL_VarSpecMod.F90 +++ b/generic/MAPL_VarSpecMod.F90 @@ -13,7 +13,7 @@ module MAPL_VarSpecMod use ESMF use pFlogger - use mapl_Enumerators + use MAPL_Constants use MAPL_ExceptionHandling use mapl_VariableSpecification use mapl_VarSpecVector diff --git a/generic/StateSpecification.F90 b/generic/StateSpecification.F90 index a19fd2e75c54..26d328e07435 100644 --- a/generic/StateSpecification.F90 +++ b/generic/StateSpecification.F90 @@ -3,7 +3,7 @@ module mapl_StateSpecification use ESMF use pFlogger - use mapl_Enumerators + use mapl_Constants use mapl_ErrorHandlingMod use mapl_VarSpecVector use mapl_VarSpecMod diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index e914a1c911b5..88d33a3d3c94 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -6,7 +6,7 @@ set (srcs MAPL_NUOPCWrapperMod.F90 ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.profiler MAPL.history TYPE ${MAPL_LIBRARY_TYPE}) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index a8e7ee8c170e..fc615b35e2b2 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -5,7 +5,7 @@ module MAPL_CapGridCompMod use ESMF use MAPL_ExceptionHandling use MAPL_BaseMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_Profiler, only: BaseProfiler, get_global_time_profiler, get_global_memory_profiler use MAPL_ProfMod use MAPL_MemUtilsMod diff --git a/gridcomps/History/CMakeLists.txt b/gridcomps/History/CMakeLists.txt index 85a10308025b..a0226636e5ed 100644 --- a/gridcomps/History/CMakeLists.txt +++ b/gridcomps/History/CMakeLists.txt @@ -6,7 +6,7 @@ set (srcs MAPL_HistoryGridComp.F90 ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.profiler TYPE ${MAPL_LIBRARY_TYPE}) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) diff --git a/gridcomps/History/MAPL_HistoryCollection.F90 b/gridcomps/History/MAPL_HistoryCollection.F90 index e5e230261f54..1c165ea19f64 100644 --- a/gridcomps/History/MAPL_HistoryCollection.F90 +++ b/gridcomps/History/MAPL_HistoryCollection.F90 @@ -88,6 +88,7 @@ module MAPL_HistoryCollectionMod logical :: timeseries_output = .false. logical :: recycle_track = .false. type(HistoryTrajectory) :: trajectory + character(len=ESMF_MAXSTR) :: positive contains procedure :: AddGrid end type HistoryCollection diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index df8c4cc6003a..6c44ea5d0ff2 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -13,7 +13,7 @@ module MAPL_HistoryGridCompMod use ESMFL_Mod use MAPL_BaseMod use MAPL_VarSpecMod - use MAPL_ConstantsMod + use MAPL_Constants use MAPL_IOMod use MAPL_CommsMod use MAPL_GenericMod @@ -891,6 +891,18 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%field_set => field_set +! Decide on orientation of output +! ------------------------------- + + call ESMF_ConfigFindLabel(cfg,trim(string)//'positive:',isPresent=isPresent,rc=status) + if (isPresent) then + call ESMF_ConfigGetAttribute(cfg,value=list(n)%positive,rc=status) + _VERIFY(status) + _ASSERT(list(n)%positive=='down'.or.list(n)%positive=='up',"positive value for collection must be down or up") + else + list(n)%positive = 'down' + end if + ! Get an optional list of output levels ! ------------------------------------- @@ -2410,7 +2422,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%vdata = VerticalData(levels=list(n)%levels,rc=status) _VERIFY(status) else - list(n)%vdata = VerticalData(rc=status) + list(n)%vdata = VerticalData(positive=list(n)%positive,rc=status) _VERIFY(status) end if call list(n)%mNewCFIO%set_param(deflation=list(n)%deflate,rc=status) diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 3c4f1f50267d..e686ec16bb1e 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -4,6 +4,7 @@ module pFIO_NetCDF4_FileFormatterMod use, intrinsic :: iso_fortran_env, only: INT32, INT64 use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 + use, intrinsic :: iso_fortran_env, only: error_unit use MAPL_ExceptionHandling use pFIO_ConstantsMod use pFIO_UnlimitedEntityMod @@ -246,17 +247,18 @@ subroutine open(this, file, mode, unusable, comm, info, rc) this%info = MPI_INFO_NULL end if + !$omp critical if (this%parallel) then - !$omp critical status = nf90_open(file, IOR(omode, NF90_MPIIO), comm=this%comm, info=this%info, ncid=this%ncid) - !$omp end critical - _VERIFY(status) else - !$omp critical status = nf90_open(file, IOR(omode, NF90_SHARE), this%ncid) - !$omp end critical - _VERIFY(status) end if + if (status /= nf90_noerr) then + write(error_unit, fmt='("nf90_open: returned error code (", I0,") opening ", A, " [", A,"]")') & + status,trim(file),trim(nf90_strerror(status)) + end if + !$omp end critical + _VERIFY(status) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index bfd8d4bb6bd3..cd68a4826721 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -3,7 +3,6 @@ esma_set_this (OVERRIDE MAPL.shared) set (srcs hash.c hinterp.F - MAPL_Constants.F90 MAPL_DirPath.F90 MAPL_ErrorHandling.F90 MAPL_Hash.F90 @@ -21,7 +20,6 @@ set (srcs sort.c MAPL_ExceptionHandling.F90 String.F90 - Enumerators.F90 MaplShared.F90 TimeUtils.F90 # Fortran submodules @@ -29,7 +27,7 @@ set (srcs Shmem/Shmem.F90 Shmem/Shmem_implementation.F90 ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES GFTL_SHARED::gftl-shared MPI::MPI_Fortran PFLOGGER::pflogger TYPE ${MAPL_LIBRARY_TYPE}) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.constants GFTL_SHARED::gftl-shared MPI::MPI_Fortran PFLOGGER::pflogger TYPE ${MAPL_LIBRARY_TYPE}) target_include_directories (${this} PUBLIC $) @@ -37,4 +35,5 @@ if (PFUNIT_FOUND) add_subdirectory (tests) endif () +add_subdirectory(Constants) #add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/shared/Constants/CMakeLists.txt b/shared/Constants/CMakeLists.txt new file mode 100644 index 000000000000..b2acf46cdc55 --- /dev/null +++ b/shared/Constants/CMakeLists.txt @@ -0,0 +1,17 @@ +esma_set_this (OVERRIDE MAPL.constants) + +set (srcs + InternalConstants.F90 + MathConstants.F90 + PhysicalConstants.F90 + Constants.F90 + ) + +esma_add_library (${this} SRCS ${srcs} TYPE ${MAPL_LIBRARY_TYPE}) + +target_include_directories (${this} PUBLIC $) + +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) + +option(USE_CODATA_2018_CONSTANTS "Use CODATA 2018 Constants" OFF) +target_compile_definitions (${this} PRIVATE $<$:CODATA_2018_CONSTANTS>) diff --git a/shared/Constants/Constants.F90 b/shared/Constants/Constants.F90 new file mode 100644 index 000000000000..e80e0ef834fc --- /dev/null +++ b/shared/Constants/Constants.F90 @@ -0,0 +1,21 @@ +module MAPL_Constants + +use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 +use MAPL_InternalConstantsMod +use MAPL_MathConstantsMod +use MAPL_PhysicalConstantsMod + +contains + +subroutine initialize_constants() + implicit none +end subroutine initialize_constants + +end module MAPL_Constants + +! For backwards compatibility +module MAPL_ConstantsMod +use MAPL_Constants +end module MAPL_ConstantsMod + + diff --git a/shared/Constants/InternalConstants.F90 b/shared/Constants/InternalConstants.F90 new file mode 100644 index 000000000000..b1149437c9a8 --- /dev/null +++ b/shared/Constants/InternalConstants.F90 @@ -0,0 +1,168 @@ +module MAPL_InternalConstantsMod + + use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 + + implicit none +!============================================================================= +!BOP + +! !MODULE: -- A container module for MAPL internal constants + +! !PUBLIC VARIABLES: + integer,parameter :: MAPL_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: MAPL_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: MAPL_RN = kind(1.0) ! native real + integer,parameter :: MAPL_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: MAPL_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: MAPL_IN = kind(1) ! native integer + + integer,parameter :: MAPL_UNDEFINED_INTEGER = 1-huge(1) + real,parameter :: MAPL_UNDEFINED_REAL = huge(1.) + real(kind=REAL64), parameter :: MAPL_UNDEFINED_REAL64 = huge(1.d0) + character(len=*), parameter :: MAPL_UNDEFINED_CHAR = '**' + character(len=*), parameter :: MAPL_GRID_NAME_DEFAULT = 'UNKNOWN' + character(len=*), parameter :: MAPL_GRID_FILE_NAME_DEFAULT = 'UNKNOWN' + character(len=*), parameter :: MAPL_CF_COMPONENT_SEPARATOR = '.' + + enum, bind(c) + enumerator MAPL_TimerModeOld + enumerator MAPL_TimerModeRootOnly + enumerator MAPL_TimerModeMax + enumerator MAPL_TimerModeMinMax + endenum + + enum, bind(c) + enumerator :: MAPL_UseStarrQsat = 1 + enumerator MAPL_UseGoffGratchQsat + enumerator MAPL_UseMurphyKoopQsat + enumerator MAPL_UseCAMQsat + endenum + + enum, bind(c) + enumerator MAPL_Unknown + enumerator MAPL_IsGather + enumerator MAPL_IsScatter + endenum + + integer, parameter :: MAPL_TileNameLength = 128 + + integer, parameter :: MAPL_NoShm=255 + + enum, bind(c) + enumerator MAPL_SUCCESS + enumerator MAPL_FILE_NOT_FOUND + endenum + + enum, bind(c) + enumerator :: MAPL_DimTopoEdge = -1 + enumerator MAPL_DimTopoCyclic + enumerator MAPL_DimTopoCenter + endenum + + integer, parameter :: MAPL_CplUNKNOWN = 0 !Not used + integer, parameter :: MAPL_CplSATISFIED = 1 + integer, parameter :: MAPL_CplNEEDED = 2 !not used + integer, parameter :: MAPL_CplNOTNEEDED = 4 !not used + integer, parameter :: MAPL_FriendlyVariable = 8 + integer, parameter :: MAPL_FieldItem = 8 + integer, parameter :: MAPL_BundleItem = 16 + integer, parameter :: MAPL_StateItem = 32 + integer, parameter :: MAPL_NoRestart = 64 !not used + + enum, bind(c) + enumerator MAPL_Write2Disk + enumerator MAPL_Write2RAM + endenum + + enum, bind(c) + enumerator MAPL_VLocationNone + enumerator MAPL_VLocationEdge + enumerator MAPL_VLocationCenter + endenum + + enum, bind(c) + enumerator MAPL_DimsUnknown + enumerator MAPL_DimsVertOnly + enumerator MAPL_DimsHorzOnly + enumerator MAPL_DimsHorzVert + enumerator MAPL_DimsTileOnly + enumerator MAPL_DimsTileTile + enumerator MAPL_DimsNone + endenum + + enum, bind(c) + enumerator :: MAPL_ScalarField = 1 + enumerator MAPL_VectorField + endenum + + enum, bind(c) + enumerator MAPL_CplAverage + enumerator MAPL_CplMin + enumerator MAPL_CplMax + enumerator MAPL_CplAccumulate + enumerator MAPL_MinMaxUnknown ! This was defined to MAPL_CplAverage before and is not used + endenum + + enum, bind(c) + enumerator :: MAPL_AttrGrid = 1 + enumerator MAPL_AttrTile + endenum + + enum, bind(c) + enumerator MAPL_Uninitialized + enumerator MAPL_InitialDefault + enumerator MAPL_InitialRestart + endenum + + enum, bind(c) + enumerator :: MAPL_DuplicateEntry = -99 + enumerator :: MAPL_ConnUnknown = -1 + enumerator MAPL_Self + enumerator MAPL_Import + enumerator MAPL_Export + endenum + + enum, bind(c) + enumerator :: MAPL_FirstPhase = 1 + enumerator MAPL_SecondPhase + enumerator MAPL_ThirdPhase + enumerator MAPL_FourthPhase + enumerator MAPL_FifthPhase + endenum + + integer, parameter :: MAPL_Ocean = 0 + integer, parameter :: MAPL_Lake = 19 + integer, parameter :: MAPL_LandIce = 20 + integer, parameter :: MAPL_Land = 100 + integer, parameter :: MAPL_Vegetated = 101 + integer, parameter :: MAPL_NumVegTypes = 6 + + enum, bind(c) + enumerator MAPL_AGrid + enumerator MAPL_CGrid + enumerator MAPL_DGrid + endenum + + enum, bind(c) + enumerator MAPL_RotateLL + enumerator MAPL_RotateCube + endenum + + enum, bind(c) + enumerator MAPL_HorzTransOrderBinning + enumerator MAPL_HorzTransOrderBilinear + enumerator :: MAPL_HorzTransOrderFraction = 98 + enumerator MAPL_HorzTransOrderSample + endenum + + enum, bind(c) + enumerator MAPL_RestartOptional + enumerator MAPL_RestartSkip + enumerator MAPL_RestartRequired + enumerator MAPL_RestartBootstrap + enumerator MAPL_RestartSkipInitial + endenum + +!EOP + +end module MAPL_InternalConstantsMod diff --git a/shared/Constants/MathConstants.F90 b/shared/Constants/MathConstants.F90 new file mode 100644 index 000000000000..dad5e3c3cace --- /dev/null +++ b/shared/Constants/MathConstants.F90 @@ -0,0 +1,21 @@ +module MAPL_MathConstantsMod + + use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 + + implicit none + +!============================================================================= +!BOP + +! !MODULE: -- A container module for MAPL mathematical constants + +! !PUBLIC VARIABLES: + real(kind=REAL64), parameter :: MAPL_PI_R8 = 3.14159265358979323846d0 + real(kind=REAL32), parameter :: MAPL_PI = MAPL_PI_R8 + real(kind=REAL64), parameter :: MAPL_DEGREES_TO_RADIANS_R8 = MAPL_PI_R8 / 180. + real(kind=REAL32), parameter :: MAPL_DEGREES_TO_RADIANS = MAPL_PI / 180. + real(kind=REAL64), parameter :: MAPL_RADIANS_TO_DEGREES = 180. / MAPL_PI_R8 + +!EOP + +end module MAPL_MathConstantsMod diff --git a/shared/Constants/PhysicalConstants.F90 b/shared/Constants/PhysicalConstants.F90 new file mode 100644 index 000000000000..a685340f3f25 --- /dev/null +++ b/shared/Constants/PhysicalConstants.F90 @@ -0,0 +1,80 @@ +module MAPL_PhysicalConstantsMod + + use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 + use MAPL_MathConstantsMod, only: MAPL_PI_R8, MAPL_PI, MAPL_RADIANS_TO_DEGREES, MAPL_DEGREES_TO_RADIANS_R8 + implicit none + +!============================================================================= +!BOP + +! !MODULE: -- A container module for MAPL physical constants + +! !PUBLIC VARIABLES: + + ! Universal Constants +#if defined(CODATA_2018_CONSTANTS) + real, parameter :: MAPL_STFBOL = 5.670374419E-8 ! W/(m^2 K^4) + real, parameter :: MAPL_AVOGAD = 6.02214076E26 ! 1/kmol + real, parameter :: MAPL_RUNIV = 8314.462618 ! J/(Kmole K) +#else + real, parameter :: MAPL_STFBOL = 5.6734E-8 ! W/(m^2 K^4) + real, parameter :: MAPL_AVOGAD = 6.023E26 ! 1/kmol + real, parameter :: MAPL_RUNIV = 8314.47 ! J/(Kmole K) +#endif + + ! Earth Constants + real(kind=REAL64), parameter :: MAPL_PSDRY = 98305.0_REAL64 ! Pa + real, parameter :: MAPL_SECONDS_PER_SIDEREAL_DAY = 86164.0 ! s + real, parameter :: MAPL_GRAV = 9.80665 ! m^2/s + real, parameter :: MAPL_RADIUS = 6371.0E3 ! m + real(kind=REAL64), parameter :: MAPL_OMEGA_R8 = 2.0*MAPL_PI_R8/MAPL_SECONDS_PER_SIDEREAL_DAY ! 1/s + real(kind=REAL32), parameter :: MAPL_OMEGA = 2.0*MAPL_PI/MAPL_SECONDS_PER_SIDEREAL_DAY ! 1/s + real(kind=REAL64), parameter :: MAPL_EARTH_ECCENTRICITY = 8.1819190842622d-2 ! -- + real(kind=REAL64), parameter :: MAPL_EARTH_SEMIMAJOR_AXIS = 6378137 ! m + real(kind=REAL64), parameter :: MAPL_KM_PER_DEG = (1.0/(MAPL_RADIUS/1000.)) * MAPL_RADIANS_TO_DEGREES + real(kind=REAL64), parameter :: MAPL_DEG_PER_KM = (MAPL_RADIUS/1000.) * MAPL_DEGREES_TO_RADIANS_R8 + + + ! Physical properties + real, parameter :: MAPL_H2OMW = 18.015 ! kg/Kmole + real, parameter :: MAPL_O3MW = 47.9982 ! kg/Kmole + real, parameter :: MAPL_LATENT_HEAT_VAPORIZATION = 2.4665E6 ! J/kg @15C @1atm + real, parameter :: MAPL_ALHL = MAPL_LATENT_HEAT_VAPORIZATION ! J/kg + real, parameter :: MAPL_LATENT_HEAT_FUSION = 3.3370E5 ! J/kg @1atm + real, parameter :: MAPL_ALHF = MAPL_LATENT_HEAT_FUSION ! J/kg + real, parameter :: MAPL_LATENT_HEAT_SUBLIMATION = MAPL_ALHL+MAPL_ALHF ! J/kg + real, parameter :: MAPL_ALHS = MAPL_LATENT_HEAT_SUBLIMATION ! J/kg + + ! Earth Specific Chemistry and Thermodynamic Constants + real, parameter :: MAPL_AIRMW = 28.965 ! kg/Kmole + real, parameter :: MAPL_RDRY = MAPL_RUNIV/MAPL_AIRMW ! J/(kg K) + real, parameter :: MAPL_CPDRY = 3.5*MAPL_RDRY ! J/(kg K) + real, parameter :: MAPL_CVDRY = MAPL_CPDRY-MAPL_RDRY ! J/(kg K) + real, parameter :: MAPL_RVAP = MAPL_RUNIV/MAPL_H2OMW ! J/(kg K) + real, parameter :: MAPL_CPVAP = 4.*MAPL_RVAP ! J/(kg K) + real, parameter :: MAPL_CVVAP = MAPL_CPVAP-MAPL_RVAP ! J/(kg K) + real, parameter :: MAPL_KAPPA = MAPL_RDRY/MAPL_CPDRY ! (2.0/7.0) + real, parameter :: MAPL_EPSILON = MAPL_H2OMW/MAPL_AIRMW ! -- + real, parameter :: MAPL_DELTAP = MAPL_CPVAP/MAPL_CPDRY ! -- + real, parameter :: MAPL_DELTAV = MAPL_CVVAP/MAPL_CVDRY ! -- + real, parameter :: MAPL_GAMMAD = MAPL_CPDRY/MAPL_CVDRY ! -- + real, parameter :: MAPL_RGAS = MAPL_RDRY ! J/(kg K) (DEPRECATED) + real, parameter :: MAPL_CP = MAPL_RGAS/MAPL_KAPPA ! J/(kg K) (DEPRECATED) + real, parameter :: MAPL_VIREPS = 1.0/MAPL_EPSILON-1.0 ! (DEPRECATED) + real, parameter :: MAPL_P00 = 100000.0 ! Pa + real, parameter :: MAPL_CAPICE = 2000. ! J/(K kg) + real, parameter :: MAPL_CAPWTR = 4218. ! J/(K kg) + real, parameter :: MAPL_RHOWTR = 1000. ! kg/m^3 + real, parameter :: MAPL_NUAIR = 1.533E-5 ! m^2/S (@ 18C) + real, parameter :: MAPL_TICE = 273.16 ! K + real, parameter :: MAPL_SRFPRS = 98470 ! Pa + real, parameter :: MAPL_KARMAN = 0.40 ! -- + real, parameter :: MAPL_USMIN = 1.00 ! m/s + real, parameter :: MAPL_RHO_SEAWATER = 1026.0 ! sea water density [kg/m^3] + real, parameter :: MAPL_RHO_SEAICE = 917.0 ! sea ice density [kg/m^3] + real, parameter :: MAPL_RHO_SNOW = 330.0 ! snow density [kg/m^3] + real, parameter :: MAPL_CELSIUS_TO_KELVIN = 273.15 ! K + +!EOP + +end module MAPL_PhysicalConstantsMod diff --git a/shared/Enumerators.F90 b/shared/Enumerators.F90 deleted file mode 100644 index 4c3345047023..000000000000 --- a/shared/Enumerators.F90 +++ /dev/null @@ -1,85 +0,0 @@ -module mapl_Enumerators - implicit none - private - - integer, public, parameter :: MAPL_CplUNKNOWN = 0 - integer, public, parameter :: MAPL_CplSATISFIED = 1 - integer, public, parameter :: MAPL_CplNEEDED = 2 - integer, public, parameter :: MAPL_CplNOTNEEDED = 4 - integer, public, parameter :: MAPL_FriendlyVariable = 8 - integer, public, parameter :: MAPL_FieldItem = 8 - integer, public, parameter :: MAPL_BundleItem = 16 - integer, public, parameter :: MAPL_StateItem = 32 - integer, public, parameter :: MAPL_NoRestart = 64 - - integer, public, parameter :: MAPL_Write2Disk = 0 - integer, public, parameter :: MAPL_Write2RAM = 1 - - integer, public, parameter :: MAPL_VLocationNone = 0 - integer, public, parameter :: MAPL_VLocationEdge = 1 - integer, public, parameter :: MAPL_VLocationCenter = 2 - - integer, public, parameter :: MAPL_DimsUnknown = 0 - integer, public, parameter :: MAPL_DimsVertOnly = 1 - integer, public, parameter :: MAPL_DimsHorzOnly = 2 - integer, public, parameter :: MAPL_DimsHorzVert = 3 - integer, public, parameter :: MAPL_DimsTileOnly = 4 - integer, public, parameter :: MAPL_DimsTileTile = 5 - integer, public, parameter :: MAPL_DimsNone = 6 - - integer, public, parameter :: MAPL_ScalarField = 1 - integer, public, parameter :: MAPL_VectorField = 2 - - - integer, public, parameter :: MAPL_CplAverage = 0 - integer, public, parameter :: MAPL_CplMin = 1 - integer, public, parameter :: MAPL_CplMax = 2 - integer, public, parameter :: MAPL_CplAccumulate = 3 - integer, public, parameter :: MAPL_MinMaxUnknown = MAPL_CplAverage - - integer, public, parameter :: MAPL_AttrGrid = 1 - integer, public, parameter :: MAPL_AttrTile = 2 - - integer, public, parameter :: MAPL_Uninitialized = 0 - integer, public, parameter :: MAPL_InitialDefault = 1 - integer, public, parameter :: MAPL_InitialRestart = 2 - - integer, public, parameter :: MAPL_DuplicateEntry = -99 - integer, public, parameter :: MAPL_Self = 0 - integer, public, parameter :: MAPL_Import = 1 - integer, public, parameter :: MAPL_Export = 2 - integer, public, parameter :: MAPL_ConnUnknown = -1 - integer, public, parameter :: MAPL_FirstPhase = 1 - integer, public, parameter :: MAPL_SecondPhase = MAPL_FirstPhase+1 - integer, public, parameter :: MAPL_ThirdPhase = MAPL_FirstPhase+2 - integer, public, parameter :: MAPL_FourthPhase = MAPL_FirstPhase+3 - integer, public, parameter :: MAPL_FifthPhase = MAPL_FirstPhase+4 - - integer, public, parameter :: MAPL_Ocean = 0 - integer, public, parameter :: MAPL_Lake = 19 - integer, public, parameter :: MAPL_LandIce = 20 - integer, public, parameter :: MAPL_Land = 100 - integer, public, parameter :: MAPL_Vegetated = 101 - - integer, public, parameter :: MAPL_NumVegTypes = 6 - - integer, public, parameter :: MAPL_AGrid = 0 - integer, public, parameter :: MAPL_CGrid = 1 - integer, public, parameter :: MAPL_DGrid = 2 - - integer, public, parameter :: MAPL_RotateLL = 0 - integer, public, parameter :: MAPL_RotateCube = 1 - - - integer, public, parameter :: MAPL_HorzTransOrderBinning = 0 - integer, public, parameter :: MAPL_HorzTransOrderBilinear = 1 - integer, public, parameter :: MAPL_HorzTransOrderFraction = 98 - integer, public, parameter :: MAPL_HorzTransOrderSample = 99 - - integer, public, parameter :: MAPL_RestartOptional = 0 - integer, public, parameter :: MAPL_RestartSkip = 1 - integer, public, parameter :: MAPL_RestartRequired = 2 - integer, public, parameter :: MAPL_RestartBootstrap = 3 - integer, public, parameter :: MAPL_RestartSkipInitial = 4 - -end module mapl_Enumerators diff --git a/shared/MAPL_Constants.F90 b/shared/MAPL_Constants.F90 deleted file mode 100644 index fb70c5c691b2..000000000000 --- a/shared/MAPL_Constants.F90 +++ /dev/null @@ -1,80 +0,0 @@ -module MAPL_ConstantsMod - -use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 -implicit none -private - - -!============================================================================= -!BOP - -! !MODULE: -- A container module for global constants - -! !PUBLIC VARIABLES: - -integer,parameter, public :: MAPL_R8 = selected_real_kind(12) ! 8 byte real -integer,parameter, public :: MAPL_R4 = selected_real_kind( 6) ! 4 byte real -integer,parameter, public :: MAPL_RN = kind(1.0) ! native real -integer,parameter, public :: MAPL_I8 = selected_int_kind (13) ! 8 byte integer -integer,parameter, public :: MAPL_I4 = selected_int_kind ( 6) ! 4 byte integer -integer,parameter, public :: MAPL_IN = kind(1) ! native integer - -real(kind=REAL64), parameter, public :: MAPL_PI_R8 = 3.14159265358979323846d0 -real(kind=REAL32), parameter, public :: MAPL_PI = MAPL_PI_R8 -real(kind=REAL64), parameter, public :: MAPL_DEGREES_TO_RADIANS = MAPL_PI_R8 / 180 -real(kind=REAL64), parameter, public :: MAPL_RADIANS_TO_DEGREES = 180 / MAPL_PI_R8 - -real(kind=REAL64), parameter, public :: MAPL_PSDRY = 98305.0_REAL64 - -real, parameter, public :: MAPL_GRAV = 9.80665 ! m^2/s -real, parameter, public :: MAPL_RADIUS = 6371.0E3 ! m -real, parameter, public :: MAPL_OMEGA = 2.0*MAPL_PI/86164.0 ! 1/s -real, parameter, public :: MAPL_STFBOL = 5.6734E-8 ! W/(m^2 K^4) -real, parameter, public :: MAPL_AIRMW = 28.965 ! kg/Kmole -real, parameter, public :: MAPL_H2OMW = 18.015 ! kg/Kmole -real, parameter, public :: MAPL_O3MW = 47.9982 ! kg/Kmole -real, parameter, public :: MAPL_RUNIV = 8314.47 ! J/(Kmole K) -real, parameter, public :: MAPL_ALHL = 2.4665E6 ! J/kg @15C -real, parameter, public :: MAPL_ALHF = 3.3370E5 ! J/kg -real, parameter, public :: MAPL_ALHS = MAPL_ALHL+MAPL_ALHF ! J/kg - -real, parameter, public :: MAPL_RDRY = MAPL_RUNIV/MAPL_AIRMW ! J/(kg K) -real, parameter, public :: MAPL_CPDRY = 3.5*MAPL_RDRY ! J/(kg K) -real, parameter, public :: MAPL_CVDRY = MAPL_CPDRY-MAPL_RDRY ! J/(kg K) - -real, parameter, public :: MAPL_RVAP = MAPL_RUNIV/MAPL_H2OMW ! J/(kg K) -real, parameter, public :: MAPL_CPVAP = 4.*MAPL_RVAP ! J/(kg K) -real, parameter, public :: MAPL_CVVAP = MAPL_CPVAP-MAPL_RVAP ! J/(kg K) - -real, parameter, public :: MAPL_KAPPA = MAPL_RDRY/MAPL_CPDRY ! (2.0/7.0) - -real, parameter, public :: MAPL_EPSILON= MAPL_H2OMW/MAPL_AIRMW ! -- -real, parameter, public :: MAPL_DELTAP = MAPL_CPVAP/MAPL_CPDRY ! -- -real, parameter, public :: MAPL_DELTAV = MAPL_CVVAP/MAPL_CVDRY ! -- -real, parameter, public :: MAPL_GAMMAD = MAPL_CPDRY/MAPL_CVDRY ! -- - -real, parameter, public :: MAPL_RGAS = MAPL_RDRY ! J/(kg K) (DEPRECATED) -real, parameter, public :: MAPL_CP = MAPL_RGAS/MAPL_KAPPA ! J/(kg K) (DEPRECATED) -real, parameter, public :: MAPL_VIREPS = 1.0/MAPL_EPSILON-1.0 ! (DEPRECATED) - -real, parameter, public :: MAPL_P00 = 100000.0 ! Pa -real, parameter, public :: MAPL_CAPICE = 2000. ! J/(K kg) -real, parameter, public :: MAPL_CAPWTR = 4218. ! J/(K kg) -real, parameter, public :: MAPL_RHOWTR = 1000. ! kg/m^3 -real, parameter, public :: MAPL_NUAIR = 1.533E-5 ! m^2/S (@ 18C) -real, parameter, public :: MAPL_TICE = 273.16 ! K -real, parameter, public :: MAPL_SRFPRS = 98470 ! Pa -real, parameter, public :: MAPL_KARMAN = 0.40 ! -- -real, parameter, public :: MAPL_USMIN = 1.00 ! m/s -real, parameter, public :: MAPL_AVOGAD = 6.023E26 ! 1/kmol - -real, parameter, public :: MAPL_RHO_SEAWATER = 1026.0 ! sea water density [kg/m^3]. SA: should it be = 1026 kg/m^3? -real, parameter, public :: MAPL_RHO_SEAICE = 917.0 ! sea ice density [kg/m^3]. SA: should it be = 917 kg/m^3? -real, parameter, public :: MAPL_RHO_SNOW = 330.0 ! snow density [kg/m^3]. SA: should it be = 330 kg/m^3? - - - -!EOP - -end module MAPL_CONSTANTSMOD - diff --git a/shared/MAPL_DirPath.F90 b/shared/MAPL_DirPath.F90 index d960e4f441a3..843bcc4a4a41 100644 --- a/shared/MAPL_DirPath.F90 +++ b/shared/MAPL_DirPath.F90 @@ -2,13 +2,12 @@ module MAPL_DirPathMod use MAPL_KeywordEnforcerMod + use MAPL_Constants use gFTL_StringVector private public :: DirPath public :: dirpaths - public :: MAPL_SUCCESS - public :: MAPL_FILE_NOT_FOUND type, extends(StringVector) :: DirPath private @@ -19,9 +18,6 @@ module MAPL_DirPathMod type(DirPath) :: dirpaths - integer, parameter :: MAPL_SUCCESS = 0 - integer, parameter :: MAPL_FILE_NOT_FOUND = 1 - contains function find(this, file, unusable, rc) result(full_name) diff --git a/shared/MaplShared.F90 b/shared/MaplShared.F90 index 94a0fc48c324..ba302964d24f 100644 --- a/shared/MaplShared.F90 +++ b/shared/MaplShared.F90 @@ -15,9 +15,8 @@ module MaplShared use mapl_HashMod use mapl_ErrorHandlingMod use mapl_DirPathMod - use mapl_ConstantsMod + use mapl_Constants use mapl_CommGroupDescriptionMod use mapl_AbstractCommSplitterMod - use mapl_Enumerators end module MaplShared diff --git a/shared/Shmem/Shmem.F90 b/shared/Shmem/Shmem.F90 index 13c39693db7f..7247ec5c5cfd 100644 --- a/shared/Shmem/Shmem.F90 +++ b/shared/Shmem/Shmem.F90 @@ -6,6 +6,7 @@ module MAPL_Shmem use, intrinsic :: ISO_C_BINDING use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 + use MAPL_Constants implicit none private @@ -29,8 +30,6 @@ module MAPL_Shmem public :: MAPL_GetNewRank - integer, public, parameter :: MAPL_NoShm=255 - character*30 :: Iam="MAPL_ShmemMod in line " integer(c_int), parameter :: IPC_CREAT = 512 @@ -122,6 +121,7 @@ end subroutine perror module procedure MAPL_AllocNodeArray_3DR8 module procedure MAPL_AllocNodeArray_4DR8 module procedure MAPL_AllocNodeArray_5DR8 + module procedure MAPL_AllocNodeArray_6DR8 end interface MAPL_AllocNodeArray interface MAPL_DeAllocNodeArray @@ -139,6 +139,7 @@ end subroutine perror module procedure MAPL_DeAllocNodeArray_3DR8 module procedure MAPL_DeAllocNodeArray_4DR8 module procedure MAPL_DeAllocNodeArray_5DR8 + module procedure MAPL_DeAllocNodeArray_6DR8 end interface MAPL_DeAllocNodeArray interface MAPL_BroadcastToNodes @@ -253,6 +254,11 @@ module subroutine MAPL_DeAllocNodeArray_5DR8(Ptr,rc) integer, optional, intent(OUT) :: rc end subroutine MAPL_DeAllocNodeArray_5DR8 + module subroutine MAPL_DeAllocNodeArray_6DR8(Ptr,rc) + real(kind=REAL64), pointer :: Ptr(:,:,:,:,:,:) + integer, optional, intent(OUT) :: rc + end subroutine MAPL_DeAllocNodeArray_6DR8 + module subroutine MAPL_AllocNodeArray_1DL4(Ptr, Shp, lbd, rc) logical, pointer, intent(INOUT) :: Ptr(:) integer, intent(IN ) :: Shp(1) @@ -355,6 +361,12 @@ module subroutine MAPL_AllocNodeArray_5DR8(Ptr, Shp, lbd, rc) integer, optional, intent( OUT) :: rc end subroutine MAPL_AllocNodeArray_5DR8 + module subroutine MAPL_AllocNodeArray_6DR8(Ptr, Shp, lbd, rc) + real(kind=REAL64), pointer, intent(INOUT) :: Ptr(:,:,:,:,:,:) + integer, intent(IN ) :: Shp(6) + integer, optional, intent(IN ) :: lbd(6) + integer, optional, intent( OUT) :: rc + end subroutine MAPL_AllocNodeArray_6DR8 module subroutine MAPL_AllocateShared_1DL4(Ptr, Shp, lbd, TransRoot, rc) logical, pointer, intent(INOUT) :: Ptr(:) diff --git a/shared/Shmem/Shmem_implementation.F90 b/shared/Shmem/Shmem_implementation.F90 index aa33289b9806..4de51b02915e 100644 --- a/shared/Shmem/Shmem_implementation.F90 +++ b/shared/Shmem/Shmem_implementation.F90 @@ -352,6 +352,22 @@ _RETURN(SHM_SUCCESS) end procedure MAPL_DeAllocNodeArray_5DR8 + module procedure MAPL_DeAllocNodeArray_6DR8 + + type(c_ptr) :: Caddr + integer :: STATUS + + if(.not.MAPL_ShmInitialized) then + _RETURN(MAPL_NoShm) + endif + + Caddr = C_Loc(Ptr(lbound(Ptr,1),lbound(Ptr,2),lbound(Ptr,3),lbound(Ptr,4),lbound(Ptr,5),lbound(Ptr,6))) + call ReleaseSharedMemory(Caddr,rc=STATUS) + _VERIFY(STATUS) + + _RETURN(SHM_SUCCESS) + end procedure MAPL_DeAllocNodeArray_6DR8 + module procedure MAPL_AllocNodeArray_1DL4 implicit none type(c_ptr) :: Caddr @@ -666,6 +682,29 @@ _RETURN(SHM_SUCCESS) end procedure MAPL_AllocNodeArray_5DR8 + module procedure MAPL_AllocNodeArray_6DR8 + + type(c_ptr) :: Caddr + integer len, STATUS + + _UNUSED_DUMMY(lbd) + if(.not.MAPL_ShmInitialized) then + _RETURN(MAPL_NoShm) + endif + + len=product(Shp)*2 + + call GetSharedMemory(Caddr, len, rc=STATUS) + _VERIFY(STATUS) + + call c_f_pointer(Caddr, Ptr, Shp) ! C ptr to Fortran ptr + _ASSERT(all(shape(Ptr)==Shp),'needs informative message') + + if(present(lbd)) Ptr(lbd(1):,lbd(2):,lbd(3):,lbd(4):,lbd(5):,lbd(6):) => Ptr + + _RETURN(SHM_SUCCESS) + end procedure MAPL_AllocNodeArray_6DR8 + module procedure MAPL_AllocateShared_1DL4