diff --git a/.circleci/config.yml b/.circleci/config.yml index f3eeea071..1305449a6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -2,7 +2,7 @@ version: 2.1 # Anchors to prevent forgetting to update a version baselibs_version: &baselibs_version v7.5.0 -bcs_version: &bcs_version v10.22.3 +bcs_version: &bcs_version v10.22.5 orbs: ci: geos-esm/circleci-tools@1 @@ -22,4 +22,18 @@ workflows: repo: GEOSgcm checkout_fixture: true mepodevelop: true - persist_workspace: false # Needs to be true to run fv3/gcm experiment, costs extra + persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra + # Run GCM (1 hour, no ExtData) + - ci/run_gcm: + name: run-GCM-on-<< matrix.compiler >> + context: + - docker-hub-creds + matrix: + parameters: + compiler: [gfortran, ifort] + requires: + - build-GEOSgcm-on-<< matrix.compiler >> + repo: GEOSgcm + baselibs_version: *baselibs_version + bcs_version: *bcs_version + diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 7a4871936..e804cc434 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -16,7 +16,7 @@ jobs: name: Build GEOSgcm if: "!contains(github.event.pull_request.labels.*.name, '0 diff trivial')" runs-on: ubuntu-latest - container: + container: image: gmao/ubuntu20-geos-env-mkl:v7.5.0-openmpi_4.1.2-gcc_11.2.0 credentials: username: ${{ secrets.DOCKERHUB_USERNAME }} @@ -25,7 +25,7 @@ jobs: LANGUAGE: en_US.UTF-8 LC_ALL: en_US.UTF-8 LANG: en_US.UTF-8 - LC_TYPE: en_US.UTF-8 + LC_TYPE: en_US.UTF-8 OMPI_ALLOW_RUN_AS_ROOT: 1 OMPI_ALLOW_RUN_AS_ROOT_CONFIRM: 1 OMPI_MCA_btl_vader_single_copy_mechanism: none diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 index c9cd0aa9f..167ee57ac 100644 --- a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 +++ b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 @@ -920,6 +920,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddConnectivity ( GC, & + SRC_NAME = (/'T ','PLE ','ZLE ','TROPP_BLENDED'/), & + DST_NAME = (/'T_avg24 ','PLE_avg24 ','ZLE_avg24 ','TROPP_avg24 '/), & + DST_ID = PHYS, & + SRC_ID = SDYN, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddConnectivity ( GC, & SRC_NAME = 'PLE', & DST_NAME = 'PLEINST', & @@ -2414,6 +2423,9 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompRun(GCS(SDYN), importState=GIM(SDYN), exportState=GEX(SDYN), clock=CLOCK, PHASE=2, userRC=STATUS) VERIFY_(STATUS) + call MAPL_GenericRunCouplers( STATE, SDYN, CLOCK, RC=STATUS ) + VERIFY_(STATUS) + call MAPL_TimerOff(STATE,"SUPERDYNAMICS" ) ! Get Names Associated with Friendly Advection Bundle for Final Check for Negative Tracers diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 index d96c8d4d2..cbc4fb6bb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 @@ -1215,6 +1215,14 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddConnectivity ( GC, & + SRC_NAME = (/ 'Q ','FCLD ' /), & + DST_NAME = (/ 'Q_avg24 ','FCLD_avg24' /), & + DST_ID = CHEM, & + SRC_ID = MOIST, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'ZPBL','PPBL'/), & DST_ID = CHEM, & @@ -1258,6 +1266,14 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddConnectivity ( GC, & + SRC_NAME = (/ 'TAUCLI ', 'TAUCLW '/), & + DST_NAME = (/ 'TAUCLI_avg24', 'TAUCLW_avg24'/), & + DST_ID = CHEM, & + SRC_ID = RAD, & + RC=STATUS ) + VERIFY_(STATUS) + ! Moist Imports !-------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 index 9f3c5a755..75acc19b6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/GEOS_MoistGridComp.F90 @@ -107,7 +107,7 @@ module GEOS_MoistGridCompMod !-srf-gf-scheme !ALT-protection for GF - USE ConvectionMod, only: Disable_Convection +! USE ConvectionMod, only: Disable_Convection !ALT-protection for GF !--kml-------------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h new file mode 100644 index 000000000..c80070f66 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferPacking.h @@ -0,0 +1,984 @@ +! Code section for reordering original array pointers and packing them into +! 1D buffer that is then subsequently redistributed for load balancing. +! The actual pointers used for computation are then made to point back to the +! relevant porion of the 1D buffer after redistribution. +! ***CRITTICAL*** If fields are addedd or deleted to any of the ESMF states, or +! if any pointer name(s) is changed, this code section needs to modified accordingly. + +! import packing and redistribution + + numUsedImp = 34 ! should match the number of imports used in this subroutine + 2 (for LATS and LONS) + +! Allocate the buffer that will hold all balanced variables. The +! dimension of its 1D representation must ne NUMMAX---the larger of the +! balanced and unbalanced runs. +!------------------------------------------------------------------------ + + allocate(BUFIMP(NUMMAX*numUsedImp),stat=STATUS) + VERIFY_(STATUS) + BUFIMP = MAPL_UNDEF + LN = 0 + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'ALW', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + ALW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'BLW', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + BLW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'LWDNSRF', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + LWDNSRF => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DRPAR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DRPAR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DFPAR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DFPAR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DRNIR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DRNIR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DFNIR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DFNIR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DRUVR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DRUVR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DFUVR', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DFUVR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'EVAP', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + EVAP => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'SH', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + SH => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DEVAP', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DEV => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'DSH', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + DSH => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'SNO', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + SNO => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'PLS', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + PLS => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'PCU', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + PCU => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'PS', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + PS => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'UW', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + UW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'VW', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + VW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'UI', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + UI => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'VI', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + VI => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'THATM', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + THATM => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'QHATM', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + QHATM => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'UUA', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + UUA => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'VVA', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + VVA => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'CTATM', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + CTATM => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'CQATM', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + CQATM => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'TAUXBOT', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + TAUXBOT => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'TAUYBOT', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + TAUYBOT => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'TS_FOUND', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + TW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'SS_FOUND', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + SW => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(IMPORT,PTR1,'FRZMLT', __RC__) + call CICEReorder(BUFIMP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + FRZMLT => PTR1(1:NT) + L1 = LN + 1 + call CICEReorder(BUFIMP(L1),LATS_ORIGINAL,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + LATS => PTR1(1:NT) + L1 = LN + 1 + call CICEReorder(BUFIMP(L1),LONS_ORIGINAL,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFIMP(L1:LN) + LONS => PTR1(1:NT) + + call MAPL_BalanceWork(BUFIMP, NUMMAX, Direction=MAPL_Distribute, Handle=CICECOREBalanceHandle, __RC__) + +! REAL4 internal packing and redistribution + numIntSlices = & + NUM_ICE_CATEGORIES + & ! TSKINI + NUM_SUBTILES + & ! QS + NUM_SUBTILES + & ! CH + NUM_SUBTILES + & ! CQ + NUM_SUBTILES + & ! CM + NUM_ICE_CATEGORIES + & ! TAUAGE + 1 ! SLMASK + + allocate(BUFINT(NUMMAX*numIntSlices),stat=STATUS) + VERIFY_(STATUS) + BUFINT = MAPL_UNDEF + LN = 0 + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'TSKINI', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + TI => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'QS', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + QS => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'CH', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + CH => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'CQ', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + CQ => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'CM', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + CM => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2,'TAUAGE', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2,2) - 1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFINT(L1:LN) + TAUAGE => PTR2(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR1,'SLMASK', __RC__) + call CICEReorder(BUFINT(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,PACKIT) + LN = L1 + NUMMAX - 1 + PTR1(1:NUMMAX) => BUFINT(L1:LN) + SLMASK => PTR1(1:NT) + + call MAPL_BalanceWork(BUFINT, NUMMAX, Direction=MAPL_Distribute, Handle=CICECOREBalanceHandle, __RC__) + +! REAL8 internal packing and redistribution + numIntSlices8 = & + NUM_SUBTILES + & ! FR + NUM_ICE_CATEGORIES + & ! VOLICE + NUM_ICE_CATEGORIES + & ! VOLSNO + NUM_ICE_CATEGORIES + & ! VOLPOND + NUM_ICE_CATEGORIES + & ! APONDN + NUM_ICE_CATEGORIES + & ! HPONDN + NUM_ICE_LAYERS*NUM_ICE_CATEGORIES + & ! ERGICE + NUM_SNOW_LAYERS*NUM_ICE_CATEGORIES ! ERGSNO + + allocate(BUFINT8(NUMMAX*numIntSlices8),stat=STATUS) + VERIFY_(STATUS) + BUFINT8 = MAPL_UNDEF + LN = 0 + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'FR', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + FR8 => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLICE', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + VOLICE => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLSNO', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + VOLSNO => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLPOND', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + VOLPOND => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'APONDN', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + APONDN => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'HPONDN', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),PACKIT) + LN = L1 + NUMMAX*size(PTR2R8,2) - 1 + PTR2R8(1:NUMMAX,1:size(PTR2R8,2)) => BUFINT8(L1:LN) + HPONDN => PTR2R8(1:NT,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR3R8,'ERGICE', __RC__) + call CICEReorder8(BUFINT8(L1),PTR3R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR3R8,2)*size(PTR3R8,3),PACKIT) + LN = L1 + NUMMAX*size(PTR3R8,2)*size(PTR3R8,3) - 1 + PTR3R8(1:NUMMAX,1:size(PTR3R8,2),1:size(PTR3R8,3)) => BUFINT8(L1:LN) + ERGICE => PTR3R8(1:NT,:,:) + L1 = LN + 1 + call MAPL_GetPointer(INTERNAL,PTR3R8,'ERGSNO', __RC__) + call CICEReorder8(BUFINT8(L1),PTR3R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR3R8,2)*size(PTR3R8,3),PACKIT) + LN = L1 + NUMMAX*size(PTR3R8,2)*size(PTR3R8,3) - 1 + PTR3R8(1:NUMMAX,1:size(PTR3R8,2),1:size(PTR3R8,3)) => BUFINT8(L1:LN) + ERGSNO => PTR3R8(1:NT,:,:) + + call MAPL_BalanceWork(BUFINT8, NUMMAX, Direction=MAPL_Distribute, Handle=CICECOREBalanceHandle, __RC__) + + +! export packing and redistribution +! not all exports will necessarily be needed but memory will be allocated just in case + numExpSlices = & + 79 + & ! 79 total single slice exports + NUM_ICE_CATEGORIES + & ! FCONDBOTN + NUM_ICE_CATEGORIES + & ! FCONDTOPN + NUM_ICE_LAYERS*NUM_ICE_CATEGORIES + & ! TINZ + NUM_ICE_CATEGORIES + & ! SHICEN + NUM_ICE_CATEGORIES + & ! HLWUPN + NUM_ICE_CATEGORIES + & ! LWNDSRFN + NUM_ICE_CATEGORIES + & ! FSURFN + NUM_ICE_CATEGORIES + & ! TSURFN + NUM_ICE_CATEGORIES + & ! FSWSFCN + NUM_ICE_CATEGORIES + & ! ALBIN + NUM_ICE_CATEGORIES ! ALBSN + + allocate(BUFEXP(NUMMAX*numExpSlices),stat=STATUS) + VERIFY_(STATUS) + + LN = 0 + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'EMIS', __RC__) + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + EMISS => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'ALBVF', __RC__) + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + ALBVF => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'ALBVR', __RC__) + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + ALBVR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'ALBNF', __RC__) + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + ALBNF => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'ALBNR', __RC__) + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + ALBNR => PTR1(1:NT) + L1 = LN + 1 + call MAPL_GetPointer(EXPORT,PTR1,'QST', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + QST => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'TST', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + TST => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'DELTS', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + DELTS => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'DELQS', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + DELQS => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'TAUXI', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + TAUXI => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'TAUYI', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + TAUYI => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENUVR', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PENUVR => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENUVF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PENUVF => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENPAR', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PENPAR => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENPAF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PENPAF => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'EVAPOUT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + EVAPOUT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SUBLIM', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SUBLIM => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SHOUT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SHOUT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SHICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SHICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLATN', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HLATN => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLATICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HLATICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSURF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSURFe => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSURFICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSURFICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLWUP', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HLWUP => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLWUPICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HLWUPe => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWNDSRF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + LWNDSRF => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWNDSRF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SWNDSRF => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWNDICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + LWNDICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWNDICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SWNDICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRACINEW', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FRACINEW => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWDNSRF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + LWDNSRFe => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWDNSRF', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SWDNSRFe => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRAZIL', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FRAZIL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'CONGEL', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + CONGELO => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SNOICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SNOICEO => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRESH', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FRESH => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSALT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSALT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FHOCN', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FHOCN => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'PICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSWTHRU', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSWTRUO => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSWABS', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSWABSO => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTL', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + MELTL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + MELTTL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTB', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + MELTBL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTS', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + MELTSL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HSNO', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HSNO => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'HICEUNT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HICEUNT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SNOONICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SNOONICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'TSKINICE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + TSKINICE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'IAGE', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + IAGE => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'DAIDTT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + DAIDTT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'DVIDTT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + DVIDTT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FBOT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FBOTL => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'USTARI', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + USTARI => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FCONDTOP', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FCONDTOP => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FCONDBOT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FCONDB => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'NEWICEERG', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + NIERG => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SUBLIMFLX', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SBLXOUT => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'SIALB', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SIALB => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'GHTSKIN', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + GHTSKIN => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRZMLT', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FRZMLTe => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'evap_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + EVAP_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'pr_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PR_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'prsn_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + PRSN_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'grFrazil_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + GRFRAZIL_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'grCongel_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + GRCONGEL_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'grLateral_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + GRLATERAL_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'snoToIce_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SNOTOICE_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'snomelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SNOMELT_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'tmelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + TMELT_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'bmelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + BMELT_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'sfdsi_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + SFDSI_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'hfsifrazil_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + HFSIFRAZIL_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'ialb_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + IALB_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'rsdssi_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + RSDSSI_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'rsussi_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + RSUSSI_C5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR1,'fsitherm_CMIP5', __RC__) + if ( associated(PTR1) ) then + LN = L1 + NUMMAX -1 + PTR1(1:NUMMAX) => BUFEXP(L1:LN) + FSITHERM_CMIP5 => PTR1(1:NT) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'FCONDBOTN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + FCONDBOTN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'FCONDTOPN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + FCONDTOPN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'TINZ', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + TINZ => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'SHICEN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + SHICEN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'HLWUPN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + HLWUPN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'LWNDSRFN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + LWNDSRFN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'FSURFN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + FSURFN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'TSURFN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + TSURFN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'FSWSFCN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + FSWSFCN => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'ALBIN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + ALBINe => PTR2(1:NT,:) + L1 = LN + 1 + end if + call MAPL_GetPointer(EXPORT,PTR2,'ALBSN', __RC__) + if ( associated(PTR2) ) then + LN = L1 + NUMMAX*size(PTR2,2) -1 + PTR2(1:NUMMAX,1:size(PTR2,2)) => BUFEXP(L1:LN) + ALBSNe => PTR2(1:NT,:) + end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h new file mode 100644 index 000000000..8271bae89 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/BufferUnpacking.h @@ -0,0 +1,496 @@ +! This section reverses what was done in BufferPacking by redistributing the +! the updated 1D buffer back to the original distribution and then map relevant +! portions to the original pointers in the INTERNAL and EXPORT fields. +! There is no need to do IMPORT on exit. +! ***CRITTICAL*** For any changes (pointer variable name change, field addition or +! deletion) made in BufferPacking, corresponding changes need to be made here +! as well. + +! retrieve real4 internal + call MAPL_BalanceWork(BUFINT, NUMMAX, Direction=MAPL_Retrieve, Handle=CICECOREBalanceHandle, __RC__) + L1 = 1 + call MAPL_GetPointer(INTERNAL,PTR2,'TSKINI', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR2,'QS', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR2,'CH', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR2,'CQ', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR2,'CM', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR2,'TAUAGE', __RC__) + call CICEReorder(BUFINT(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + call MAPL_GetPointer(INTERNAL,PTR1,'SLMASK', __RC__) + call CICEReorder(BUFINT(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + +! retrieve real8 internal + call MAPL_BalanceWork(BUFINT8, NUMMAX, Direction=MAPL_Retrieve, Handle=CICECOREBalanceHandle, __RC__) + L1 = 1 + call MAPL_GetPointer(INTERNAL,PTR2R8,'FR', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLICE', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLSNO', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR2R8,'VOLPOND', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR2R8,'APONDN', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR2R8,'HPONDN', __RC__) + call CICEReorder8(BUFINT8(L1),PTR2R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2R8,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2R8,2) + call MAPL_GetPointer(INTERNAL,PTR3R8,'ERGICE', __RC__) + call CICEReorder8(BUFINT8(L1),PTR3R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR3R8,2)*size(PTR3R8,3),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR3R8,2)*size(PTR3R8,3) + call MAPL_GetPointer(INTERNAL,PTR3R8,'ERGSNO', __RC__) + call CICEReorder8(BUFINT8(L1),PTR3R8,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR3R8,2)*size(PTR3R8,3),UNPACKIT) + +! retrieve export + call MAPL_BalanceWork(BUFEXP, NUMMAX, Direction=MAPL_Retrieve, Handle=CICECOREBalanceHandle, __RC__) + L1 = 1 + call MAPL_GetPointer(EXPORT,PTR1,'EMIS', __RC__) + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + call MAPL_GetPointer(EXPORT,PTR1,'ALBVF', __RC__) + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + call MAPL_GetPointer(EXPORT,PTR1,'ALBVR', __RC__) + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + call MAPL_GetPointer(EXPORT,PTR1,'ALBNF', __RC__) + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + call MAPL_GetPointer(EXPORT,PTR1,'ALBNR', __RC__) + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + call MAPL_GetPointer(EXPORT,PTR1,'QST', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'TST', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'DELTS', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'DELQS', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'TAUXI', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'TAUYI', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENUVR', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENUVF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENPAR', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'PENPAF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'EVAPOUT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SUBLIM', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SHOUT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SHICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLATN', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLATICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSURF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSURFICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLWUP', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HLWUPICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWNDSRF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWNDSRF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWNDICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWNDICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRACINEW', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'LWDNSRF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SWDNSRF', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRAZIL', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'CONGEL', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SNOICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRESH', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSALT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FHOCN', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'PICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSWTHRU', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FSWABS', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTL', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTB', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'MELTS', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HSNO', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'HICEUNT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SNOONICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'TSKINICE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'IAGE', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'DAIDTT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'DVIDTT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FBOT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'USTARI', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FCONDTOP', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FCONDBOT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'NEWICEERG', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SUBLIMFLX', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'SIALB', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'GHTSKIN', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'FRZMLT', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'evap_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'pr_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'prsn_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'grFrazil_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'grCongel_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'grLateral_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'snoToIce_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'snomelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'tmelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'bmelt_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'sfdsi_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'hfsifrazil_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'ialb_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'rsdssi_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'rsussi_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR1,'fsitherm_CMIP5', __RC__) + if ( associated(PTR1) ) then + call CICEReorder(BUFEXP(L1),PTR1,TILE_WITH_ICE,NUMMAX,HorzDims,1,UNPACKIT) + L1 = L1 + NUMMAX + end if + call MAPL_GetPointer(EXPORT,PTR2,'FCONDBOTN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'FCONDTOPN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'TINZ', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'SHICEN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'HLWUPN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'LWNDSRFN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'FSURFN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'TSURFN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'FSWSFCN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'ALBIN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + L1 = L1 + NUMMAX*size(PTR2,2) + end if + call MAPL_GetPointer(EXPORT,PTR2,'ALBSN', __RC__) + if ( associated(PTR2) ) then + call CICEReorder(BUFEXP(L1),PTR2,TILE_WITH_ICE,NUMMAX,HorzDims,size(PTR2,2),UNPACKIT) + end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 index baf3b96e1..5ae14f54a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 @@ -78,6 +78,9 @@ module GEOS_CICE4ColumnPhysGridComp type(cice_state), pointer :: ptr end type +#define PACKIT 1 +#define UNPACKIT 2 + contains !BOP @@ -3011,8 +3014,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: NUM_ICE_LAYERS ! set via resource parameter integer :: NUM_ICE_CATEGORIES ! set via resource parameter - real, pointer, dimension(:) :: LATS => null() - real, pointer, dimension(:) :: LONS => null() + real, pointer, dimension(:) :: LATS_ORIGINAL => null() + real, pointer, dimension(:) :: LONS_ORIGINAL => null() real, pointer, dimension(:) :: AREA => null() ! needed to calculate TILEAREA in SaltWaterCore @@ -3050,8 +3053,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) !----------------------------------- call MAPL_Get(MAPL, & - TILELATS = LATS , & - TILELONS = LONS , & + TILELATS = LATS_ORIGINAL , & + TILELONS = LONS_ORIGINAL , & TILEAREA = AREA , & ORBIT = ORBIT, & INTERNAL_ESMF_STATE = INTERNAL, & @@ -3062,7 +3065,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Update the skin variables each step !------------------------------------ - call CICECORE(NT=size(LONS), RC=STATUS ) + call CICECORE(NT_ORIGINAL=size(LONS_ORIGINAL), RC=STATUS ) VERIFY_(STATUS) ! All done @@ -3077,9 +3080,9 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine CICECORE(NT,RC) + subroutine CICECORE(NT_ORIGINAL,RC) - integer, intent(IN ) :: NT + integer, intent(IN ) :: NT_ORIGINAL integer, optional, intent(OUT) :: RC ! Locals @@ -3264,27 +3267,27 @@ subroutine CICECORE(NT,RC) real, pointer, dimension(:) :: FRZMLT => null() real, pointer, dimension(:,:) :: TS => null() - real, dimension(NT) :: SHF - real, dimension(NT) :: EVP - real, dimension(NT) :: SHD - real, dimension(NT) :: EVD - real, dimension(NT) :: CFQ - real, dimension(NT) :: CFT - !real, dimension(NT) :: UUA - !real, dimension(NT) :: VVA - real, dimension(NT) :: TXI - real, dimension(NT) :: TYI - real, dimension(NT) :: DQS - real, dimension(NT) :: DTS - real, dimension(NT) :: DTX - real, dimension(NT) :: DTY - real, dimension(NT) :: SWN - real, dimension(NT) :: PEN - real, dimension(NT) :: LHF - real, dimension(NT) :: ZTH - real, dimension(NT) :: SLR - real, dimension(NT) :: VSUVR - real, dimension(NT) :: VSUVF + real, allocatable, dimension(:) :: SHF + real, allocatable, dimension(:) :: EVP + real, allocatable, dimension(:) :: SHD + real, allocatable, dimension(:) :: EVD + real, allocatable, dimension(:) :: CFQ + real, allocatable, dimension(:) :: CFT + !real, allocatable, dimension(:) :: UUA + !real, allocatable, dimension(:) :: VVA + real, allocatable, dimension(:) :: TXI + real, allocatable, dimension(:) :: TYI + real, allocatable, dimension(:) :: DQS + real, allocatable, dimension(:) :: DTS + real, allocatable, dimension(:) :: DTX + real, allocatable, dimension(:) :: DTY + real, allocatable, dimension(:) :: SWN + real, allocatable, dimension(:) :: PEN + real, allocatable, dimension(:) :: LHF + real, allocatable, dimension(:) :: ZTH + real, allocatable, dimension(:) :: SLR + real, allocatable, dimension(:) :: VSUVR + real, allocatable, dimension(:) :: VSUVF integer :: N real :: DT @@ -3309,12 +3312,12 @@ subroutine CICECORE(NT,RC) real(kind=MAPL_R8), dimension(1) :: FRZMLTDB, TSCDB, TFDB, TAUXBOTDB, TAUYBOTDB, & TBOTDB, FBOTDB, RSIDEDB - real, dimension(NT) :: FSWABS - real :: YDAY - real, dimension(NT) :: ALBVRI - real, dimension(NT) :: ALBVFI - real, dimension(NT) :: ALBNRI - real, dimension(NT) :: ALBNFI + real, allocatable, dimension(:) :: FSWABS + real :: YDAY + real, allocatable, dimension(:) :: ALBVRI + real, allocatable, dimension(:) :: ALBVFI + real, allocatable, dimension(:) :: ALBNRI + real, allocatable, dimension(:) :: ALBNFI integer, allocatable :: TRCRTYPE (:) real, allocatable :: TRACERS (:,:) @@ -3404,182 +3407,27 @@ subroutine CICECORE(NT,RC) real, parameter :: SALTWATERCAP = MAPL_CAPWTR real, parameter :: SALTWATERICECAP = MAPL_CAPICE +! load balancing variables + integer :: NT, NUMMAX, pet, CICECOREBalanceHandle, L1, LN + integer :: HorzDims, numIntSlices, numIntSlices8, numExpSlices + real, target, allocatable :: BUFIMP(:), BUFINT(:), BUFEXP(:) + real(kind=MAPL_R8), target, allocatable :: BUFINT8(:) + real, pointer :: PTR1(:), PTR2(:,:), PTR3(:,:,:) + real(kind=MAPL_R8), pointer :: PTR1R8(:), PTR2R8(:,:), PTR3R8(:,:,:) + !integer :: SLICESimp(100) ! increase size if more than 100 imports + integer :: COMM + logical, dimension(NT_ORIGINAL) :: TILE_WITH_ICE + logical :: loadBalance + integer :: numUsedImp ! number of imports actually used + !character(len=ESMF_MAXSTR), dimension(29) :: NAMESimp + real, pointer :: LATS(:) + real, pointer :: LONS(:) + ! Begin... !---------- IAm = trim(COMP_NAME) // "CICECORE" - -! Pointers to inputs -!------------------- - - call MAPL_GetPointer(IMPORT,ALW , 'ALW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,BLW , 'BLW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,LWDNSRF, 'LWDNSRF', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRPAR , 'DRPAR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DFPAR , 'DFPAR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRNIR , 'DRNIR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DFNIR , 'DFNIR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DRUVR , 'DRUVR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DFUVR , 'DFUVR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,EVAP , 'EVAP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SH , 'SH' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,TAUX , 'TAUX' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,TAUY , 'TAUY' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DEV , 'DEVAP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,DSH , 'DSH' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SNO , 'SNO' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,PLS , 'PLS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,PCU , 'PCU' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,PS , 'PS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,UU , 'UU' , RC=STATUS); VERIFY_(STATUS) - !call MAPL_GetPointer(IMPORT,TF , 'TFREEZE', RC=STATUS); VERIFY_(STATUS) - - ! TODO: revisit for dual_ocean - ! call MAPL_GetPointer(IMPORT,FI , 'FRACICE', RC=STATUS); VERIFY_(STATUS) - - call MAPL_GetPointer(IMPORT,UW , 'UW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,VW , 'VW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,UI , 'UI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,VI , 'VI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,THATM , 'THATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,QHATM , 'QHATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,UHATM , 'UHATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,VHATM , 'VHATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,UUA , 'UUA' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,VVA , 'VVA' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,CTATM , 'CTATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,CQATM , 'CQATM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,CMATM , 'CMATM' , RC=STATUS); VERIFY_(STATUS) - - call MAPL_GetPointer(IMPORT,TAUXBOT, 'TAUXBOT', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,TAUYBOT, 'TAUYBOT', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,TW , 'TS_FOUND', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,SW , 'SS_FOUND', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(IMPORT,FRZMLT , 'FRZMLT' , RC=STATUS); VERIFY_(STATUS) - -! Pointers to internals -!---------------------- - - call MAPL_GetPointer(INTERNAL,TI ,'TSKINI', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,HI ,'HSKINI', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SI ,'SSKINI', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,QS , 'QS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CH , 'CH' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CQ , 'CQ' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,CM , 'CM' , RC=STATUS); VERIFY_(STATUS) - - call MAPL_GetPointer(INTERNAL,FR8 , 'FR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,VOLICE ,'VOLICE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,VOLSNO ,'VOLSNO', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,VOLPOND,'VOLPOND', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,APONDN, 'APONDN', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,HPONDN, 'HPONDN', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,ERGICE ,'ERGICE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,ERGSNO ,'ERGSNO', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,TAUAGE ,'TAUAGE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SLMASK ,'SLMASK', RC=STATUS); VERIFY_(STATUS) - -! Pointers to outputs -!-------------------- - - call MAPL_GetPointer(EXPORT,EMISS , 'EMIS' , alloc=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBVF , 'ALBVF', alloc=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBVR , 'ALBVR', alloc=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBNF , 'ALBNF', alloc=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBNR , 'ALBNR', alloc=.true., RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,QST , 'QST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TST , 'TST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DELTS , 'DELTS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DELQS , 'DELQS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TAUXI , 'TAUXI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TAUYI , 'TAUYI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PENUVR , 'PENUVR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PENUVF , 'PENUVF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PENPAR , 'PENPAR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PENPAF , 'PENPAF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVAPOUT, 'EVAPOUT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SUBLIM, 'SUBLIM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHOUT , 'SHOUT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHICE , 'SHICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLATN , 'HLATN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLATICE, 'HLATICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSURFe , 'FSURF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSURFICE,'FSURFICE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLWUPe , 'HLWUPICE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWNDSRF, 'LWNDSRF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWNDSRF, 'SWNDSRF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWNDICE, 'LWNDICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWNDICE, 'SWNDICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRACI , 'FRACI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRACINEW,'FRACINEW', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWDNSRFe,'LWDNSRF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWDNSRFe,'SWDNSRF' , RC=STATUS); VERIFY_(STATUS) - - - call MAPL_GetPointer(EXPORT,FRAZIL , 'FRAZIL' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CONGELO, 'CONGEL' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOICEO, 'SNOICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRESH , 'FRESH' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSALT , 'FSALT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FHOCN , 'FHOCN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PICE , 'PICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWTRUO, 'FSWTHRU' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWABSO, 'FSWABS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,MELTL , 'MELTL' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,MELTTL , 'MELTT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,MELTBL , 'MELTB' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,MELTSL , 'MELTS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HICE , 'HICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HSNO , 'HSNO' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HICEUNT, 'HICEUNT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOONICE,'SNOONICE', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TSKINICE, 'TSKINICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IAGE , 'IAGE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DAIDTT , 'DAIDTT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DVIDTT , 'DVIDTT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FBOTL , 'FBOT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,USTARI , 'USTARI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FCONDTOP,'FCONDTOP', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FCONDB, 'FCONDBOT', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,NIERG, 'NEWICEERG', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SBLXOUT,'SUBLIMFLX', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SIALB, 'SIALB' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GHTSKIN, 'GHTSKIN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRZMLTe, 'FRZMLT' , RC=STATUS); VERIFY_(STATUS) - - ! category dimensional exports - call MAPL_GetPointer(EXPORT,FCONDBOTN, 'FCONDBOTN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FCONDTOPN, 'FCONDTOPN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TINZ , 'TINZ' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHICEN , 'SHICEN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLWUPN , 'HLWUPN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWNDSRFN , 'LWNDSRFN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSURFN , 'FSURFN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TSURFN , 'TSURFN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWSFCN , 'FSWSFCN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBINe , 'ALBIN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBSNe , 'ALBSN' , RC=STATUS); VERIFY_(STATUS) - - ! CMIP5 exports - call MAPL_GetPointer(EXPORT,EVAP_C5, 'evap_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PR_C5, 'pr_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PRSN_C5, 'prsn_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GRFRAZIL_C5, 'grFrazil_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GRCONGEL_C5, 'grCongel_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GRLATERAL_C5, 'grLateral_CMIP5', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOTOICE_C5, 'snoToIce_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOMELT_C5, 'snomelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TMELT_C5, 'tmelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,BMELT_C5, 'bmelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SFDSI_C5, 'sfdsi_CMIP5' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HFSIFRAZIL_C5, 'hfsifrazil_CMIP5',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,IALB_C5, 'ialb_CMIP5', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RSDSSI_C5, 'rsdssi_CMIP5', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RSUSSI_C5, 'rsussi_CMIP5', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSITHERM_CMIP5,'fsitherm_CMIP5', RC=STATUS); VERIFY_(STATUS) - ! Get the time step ! ----------------- @@ -3601,10 +3449,91 @@ subroutine CICECORE(NT,RC) call MAPL_GetResource ( MAPL, DO_POND, Label="CICE_DO_POND:" , DEFAULT=0, RC=STATUS) VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, loadBalance , Label="CICE_LOAD_BALANCE:", & + DEFAULT=.TRUE., RC=STATUS) + + call MAPL_GetPointer(EXPORT,EMISS , 'EMIS' , alloc=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVF , 'ALBVF', alloc=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVR , 'ALBVR', alloc=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNF , 'ALBNF', alloc=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNR , 'ALBNR', alloc=.true., RC=STATUS); VERIFY_(STATUS) + + call ESMF_VMGetCurrent(VM, __RC__) + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=pet, __RC__) + call ESMF_VMBarrier(VM, __RC__) + call MAPL_TimerOn(MAPL, "-In_ReDist") +!load balance setup + if(loadBalance) then + + TILE_WITH_ICE = .true. + call MAPL_BalanceCreate(OrgLen=NT_ORIGINAL, Comm=COMM, Handle=CICECOREBalanceHandle, BalLen=NT, BufLen=NUMMAX, __RC__) + HorzDims = NT_ORIGINAL ! Slice size for buffer packing + +!****IMPORTANT****!!! Adjust the relevant buffer(s) and pointer assigments BufferPacking.h and BufferUnpacking.h if import/internal/export fields are added/deleted +#include "BufferPacking.h" + + else ! no load_balance + +#include "GetPtr.h" + NT = NT_ORIGINAL + LATS => LATS_ORIGINAL + LONS => LONS_ORIGINAL + + end if + call MAPL_TimerOff(MAPL, "-In_ReDist") + ! Copy friendly internals into tile-tile local variables !------------------------------------------------------- TS => TI + allocate( FSWABS (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate( ALBVRI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate( ALBVFI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate( ALBNRI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate( ALBNFI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(SHF (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(EVP (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(SHD (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(EVD (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(CFQ (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(CFT (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(TXI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(TYI (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(DQS (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(DTS (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(DTX (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(DTY (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(SWN (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(PEN (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(LHF (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(ZTH (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(SLR (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(VSUVR (NT), STAT=STATUS) + VERIFY_(STATUS) + allocate(VSUVF (NT), STAT=STATUS) + VERIFY_(STATUS) ! Initialize PAR and UVR beam fluxes !----------------------------------- @@ -4580,6 +4509,41 @@ subroutine CICECORE(NT,RC) call MAPL_TimerOff(MAPL, "-Albedo") + call ESMF_VMBarrier(VM, __RC__) + call MAPL_TimerOn(MAPL, "-Out_ReDist") + if(loadBalance) then +#include "BufferUnpacking.h" + deallocate(BUFIMP,BUFINT,BUFINT8,BUFEXP,STAT=STATUS) + VERIFY_(STATUS) + + call MAPL_BalanceDestroy(Handle=CICECOREBalanceHandle, __RC__) + endif + call MAPL_TimerOff(MAPL, "-Out_ReDist") + + deallocate(FSWABS) + deallocate(ALBVRI) + deallocate(ALBVFI) + deallocate( ALBNRI) + deallocate(ALBNFI) + deallocate(SHF) + deallocate(EVP) + deallocate(SHD) + deallocate(EVD) + deallocate(CFQ) + deallocate(CFT) + deallocate(TXI) + deallocate(TYI) + deallocate(DQS) + deallocate(DTS) + deallocate(DTX) + deallocate(DTY) + deallocate(SWN) + deallocate(PEN) + deallocate(LHF) + deallocate(ZTH) + deallocate(SLR) + deallocate(VSUVR) + deallocate(VSUVF) deallocate(TRCRTYPE) deallocate(TRACERS) deallocate(TF) @@ -6216,4 +6180,57 @@ end subroutine ALBSEAICEM2 end module GEOS_CICE4ColumnPhysGridComp - +subroutine CICEReOrder(Packed, UnPacked, MSK, Pdim, Udim, LM, DIR) + integer, intent(IN ) :: Pdim, Udim, LM, DIR + real, intent(INOUT) :: Packed(Pdim,*) + real, intent(INOUT) :: UnPacked(Udim,*) + logical, intent(IN ) :: MSK(Udim) + + integer :: I, J, L, M + + do L = 1,LM + M = 1 + do I = 1,Udim + if (MSK(I)) then + if(DIR==PACKIT) then + Packed(M,L) = UnPacked(I,L) + else + Unpacked(I,L) = Packed(M,L) + end if + M = M+1 + else + if(DIR/=PACKIT) then + UnPacked(I,L) = 0 + end if + end if + end do + end do +end subroutine CICEReOrder + +subroutine CICEReOrder8(Packed, UnPacked, MSK, Pdim, Udim, LM, DIR) + use MAPL, only : MAPL_R8 + integer, intent(IN ) :: Pdim, Udim, LM, DIR + real(kind=MAPL_R8), intent(INOUT) :: Packed(Pdim,*) + real(kind=MAPL_R8), intent(INOUT) :: UnPacked(Udim,*) + logical, intent(IN ) :: MSK(Udim) + + integer :: I, J, L, M + + do L = 1,LM + M = 1 + do I = 1,Udim + if (MSK(I)) then + if(DIR==PACKIT) then + Packed(M,L) = UnPacked(I,L) + else + Unpacked(I,L) = Packed(M,L) + end if + M = M+1 + else + if(DIR/=PACKIT) then + UnPacked(I,L) = 0 + end if + end if + end do + end do +end subroutine CICEReOrder8 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h new file mode 100644 index 000000000..e8ff00d69 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GetPtr.h @@ -0,0 +1,169 @@ +! Pointers to inputs +!------------------- + + call MAPL_GetPointer(IMPORT,ALW , 'ALW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,BLW , 'BLW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,LWDNSRF, 'LWDNSRF', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRPAR , 'DRPAR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFPAR , 'DFPAR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRNIR , 'DRNIR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFNIR , 'DFNIR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DRUVR , 'DRUVR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DFUVR , 'DFUVR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,EVAP , 'EVAP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SH , 'SH' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TAUX , 'TAUX' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TAUY , 'TAUY' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DEV , 'DEVAP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,DSH , 'DSH' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SNO , 'SNO' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PLS , 'PLS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PCU , 'PCU' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,PS , 'PS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UU , 'UU' , RC=STATUS); VERIFY_(STATUS) + !call MAPL_GetPointer(IMPORT,TF , 'TFREEZE', RC=STATUS); VERIFY_(STATUS) + + ! TODO: revisit for dual_ocean + ! call MAPL_GetPointer(IMPORT,FI , 'FRACICE', RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(IMPORT,UW , 'UW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,VW , 'VW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UI , 'UI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,VI , 'VI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,THATM , 'THATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,QHATM , 'QHATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UHATM , 'UHATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,VHATM , 'VHATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,UUA , 'UUA' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,VVA , 'VVA' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,CTATM , 'CTATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,CQATM , 'CQATM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,CMATM , 'CMATM' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(IMPORT,TAUXBOT, 'TAUXBOT', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TAUYBOT, 'TAUYBOT', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,TW , 'TS_FOUND', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,SW , 'SS_FOUND', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT,FRZMLT , 'FRZMLT' , RC=STATUS); VERIFY_(STATUS) + +! Pointers to internals +!---------------------- + + call MAPL_GetPointer(INTERNAL,TI ,'TSKINI', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HI ,'HSKINI', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SI ,'SSKINI', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,QS , 'QS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CH , 'CH' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CQ , 'CQ' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,CM , 'CM' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(INTERNAL,FR8 , 'FR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,VOLICE ,'VOLICE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,VOLSNO ,'VOLSNO', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,VOLPOND,'VOLPOND', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,APONDN, 'APONDN', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,HPONDN, 'HPONDN', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ERGICE ,'ERGICE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,ERGSNO ,'ERGSNO', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,TAUAGE ,'TAUAGE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SLMASK ,'SLMASK', RC=STATUS); VERIFY_(STATUS) + +! Pointers to outputs +!-------------------- + + call MAPL_GetPointer(EXPORT,EMISS , 'EMIS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVF , 'ALBVF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVR , 'ALBVR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNF , 'ALBNF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNR , 'ALBNR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,QST , 'QST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TST , 'TST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELTS , 'DELTS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELQS , 'DELQS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TAUXI , 'TAUXI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TAUYI , 'TAUYI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PENUVR , 'PENUVR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PENUVF , 'PENUVF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PENPAR , 'PENPAR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PENPAF , 'PENPAF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVAPOUT, 'EVAPOUT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SUBLIM, 'SUBLIM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHOUT , 'SHOUT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHICE , 'SHICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLATN , 'HLATN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLATICE, 'HLATICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSURFe , 'FSURF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSURFICE,'FSURFICE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLWUPe , 'HLWUPICE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWNDSRF, 'LWNDSRF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNDSRF, 'SWNDSRF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWNDICE, 'LWNDICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNDICE, 'SWNDICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRACI , 'FRACI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRACINEW,'FRACINEW', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWDNSRFe,'LWDNSRF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWDNSRFe,'SWDNSRF' , RC=STATUS); VERIFY_(STATUS) + + + call MAPL_GetPointer(EXPORT,FRAZIL , 'FRAZIL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CONGELO, 'CONGEL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOICEO, 'SNOICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRESH , 'FRESH' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSALT , 'FSALT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FHOCN , 'FHOCN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PICE , 'PICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWTRUO, 'FSWTHRU' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWABSO, 'FSWABS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MELTL , 'MELTL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MELTTL , 'MELTT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MELTBL , 'MELTB' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,MELTSL , 'MELTS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HICE , 'HICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HSNO , 'HSNO' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HICEUNT, 'HICEUNT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOONICE,'SNOONICE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TSKINICE, 'TSKINICE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IAGE , 'IAGE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DAIDTT , 'DAIDTT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DVIDTT , 'DVIDTT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FBOTL , 'FBOT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,USTARI , 'USTARI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FCONDTOP,'FCONDTOP', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FCONDB, 'FCONDBOT', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,NIERG, 'NEWICEERG', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SBLXOUT,'SUBLIMFLX', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SIALB, 'SIALB' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHTSKIN, 'GHTSKIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRZMLTe, 'FRZMLT' , RC=STATUS); VERIFY_(STATUS) + + ! category dimensional exports + call MAPL_GetPointer(EXPORT,FCONDBOTN, 'FCONDBOTN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FCONDTOPN, 'FCONDTOPN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TINZ , 'TINZ' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHICEN , 'SHICEN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLWUPN , 'HLWUPN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWNDSRFN , 'LWNDSRFN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSURFN , 'FSURFN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TSURFN , 'TSURFN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWSFCN , 'FSWSFCN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBINe , 'ALBIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBSNe , 'ALBSN' , RC=STATUS); VERIFY_(STATUS) + + ! CMIP5 exports + call MAPL_GetPointer(EXPORT,EVAP_C5, 'evap_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PR_C5, 'pr_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PRSN_C5, 'prsn_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GRFRAZIL_C5, 'grFrazil_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GRCONGEL_C5, 'grCongel_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GRLATERAL_C5, 'grLateral_CMIP5', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOTOICE_C5, 'snoToIce_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOMELT_C5, 'snomelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TMELT_C5, 'tmelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,BMELT_C5, 'bmelt_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SFDSI_C5, 'sfdsi_CMIP5' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HFSIFRAZIL_C5, 'hfsifrazil_CMIP5',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,IALB_C5, 'ialb_CMIP5', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RSDSSI_C5, 'rsdssi_CMIP5', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RSUSSI_C5, 'rsussi_CMIP5', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSITHERM_CMIP5,'fsitherm_CMIP5', RC=STATUS); VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 index 70d60ac9e..a5ba74ffc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/CombineRasters.F90 @@ -29,7 +29,7 @@ program mkOverlaySimple REAL_, parameter :: PI = RASTER_PI - integer :: IARGC + integer :: command_argument_count integer :: nxt, argl, fill integer :: i, j, k, l, ip integer :: STATUS, i1, i2, nvars, rvars @@ -75,7 +75,7 @@ program mkOverlaySimple rstdir='rst/' ! Write in current dir maxtiles=4000000 - I = iargc() + I = command_argument_count() if(I < 2 .or. I > 11) then print *, trim(Usage) @@ -83,7 +83,7 @@ program mkOverlaySimple end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) @@ -92,7 +92,7 @@ program mkOverlaySimple if(argl==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end if else arg = arg(3:) @@ -118,13 +118,13 @@ program mkOverlaySimple end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do Grid1 = ARG nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) Grid2 = ARG diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 index b82b1a14b..360179290 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/ConvertAlb.F90 @@ -11,7 +11,7 @@ allocate(albo(nx,ny)) allocate(alb_out(nx,ny)) -call getarg(1,ifile) +call get_command_argument(1,ifile) ofile = "data/Attic/foo"!trim(ifile)//'int1' diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 index 7f3502fbf..3b596641f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/FillMomGrid.F90 @@ -27,7 +27,7 @@ program FillMomGrid REAL(KIND=REAL64), parameter :: PI = MAPL_PI - integer :: IARGC + integer :: command_argument_count integer :: nxt, argl, fill integer :: i, j, k, l, ip integer :: STATUS, i1, i2, nvars, rvars @@ -94,7 +94,6 @@ program FillMomGrid end if nxt = 1 - !call getarg(nxt,arg) call get_command_argument(nxt,arg) do while(arg(1:1)=='-') @@ -104,7 +103,6 @@ program FillMomGrid if(argl==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - !call getarg(nxt,arg) call get_command_argument(nxt,arg) end if else @@ -133,20 +131,17 @@ program FillMomGrid end select nxt = nxt + 1 - !call getarg(nxt,arg) call get_command_argument(nxt,arg) end do Grid1 = ARG nxt = nxt + 1 - !call getarg(nxt,arg) call get_command_argument(nxt,arg) Grid2 = ARG nxt = nxt + 1 - !call getarg(nxt,arg) call get_command_argument(nxt,arg) GridFile = arg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 index 9eb0f6eea..9a64355ac 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/chk_clsm_params.F90 @@ -42,11 +42,11 @@ PROGRAM chk_clsm_params character*300 :: input_data read_file = .true. -call system ('mkdir -p idl_out') -call system ('cd bin/ ; /bin/cp ../src/plot_curves.csh . ; cd .. ; /bin/cp bin/plot_curves.csh idl_out/. ; chmod 755 idl_out/plot_curves.csh') +call execute_command_line ('mkdir -p idl_out') +call execute_command_line ('cd bin/ ; /bin/cp ../src/plot_curves.csh . ; cd .. ; /bin/cp bin/plot_curves.csh idl_out/. ; chmod 755 idl_out/plot_curves.csh') -n = iargc() +n = command_argument_count() if(n < 3) then print *, "Usage : chk_clsm_params -s Y(N) -m MaskFile" @@ -56,13 +56,13 @@ PROGRAM chk_clsm_params end if n = 1 - call getarg(n,arg) + call get_command_argument(n,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then n = n + 1 - call getarg(n,arg) + call get_command_argument(n,arg) endif else arg = arg(3:) @@ -74,7 +74,7 @@ PROGRAM chk_clsm_params MaskFile = trim(arg) end select n = n + 1 - call getarg(n,arg) + call get_command_argument(n,arg) end do if((single_tile == 'Y').or.(single_tile == 'y')) read_file = .false. @@ -195,6 +195,6 @@ PROGRAM chk_clsm_params close (10,status = 'keep') close (11,status = 'keep') -call system ('cd idl_out/ ; ./plot_curves.csh ; cd ..') +call execute_command_line ('cd idl_out/ ; ./plot_curves.csh ; cd ..') END PROGRAM chk_clsm_params diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 index e68138f70..71f0d88c6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/create_vegdyn_ndvi.F90 @@ -21,7 +21,7 @@ PROGRAM create_vegdyn_ndvi implicit none - integer :: NTILES, N, I, k, iargc, JPLH + integer :: NTILES, N, I, k, command_argument_count, JPLH integer, parameter :: nx = 8640, ny = 4320 character*400 :: BCSDIR, OUTDIR, GFILE, IMxJM, arg(5) @@ -30,18 +30,18 @@ PROGRAM create_vegdyn_ndvi real, pointer, dimension (:) :: z2, z0, ityp include 'netcdf.inc' - I = iargc() + I = command_argument_count() IMxJM ='' GFILE ='' - if(iargc() /= 5) then - print *, "Wrong Number of arguments: ", iargc() + if(command_argument_count() /= 5) then + print *, "Wrong Number of arguments: ", command_argument_count() print *, "Usage : ./create_vegdyn_ndvi BCSDIR GFILE, IMxJM JPLH OUTDIR" stop endif do n=1,5 - call getarg(n,arg(n)) + call get_command_argument(n,arg(n)) enddo read(arg(1),'(a)') BCSDIR @@ -53,8 +53,8 @@ PROGRAM create_vegdyn_ndvi ! create dirs/links ! ----------------- - call system('mkdir -p data ; cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call system('mkdir -p '//trim(OUTDIR)) + call execute_command_line('mkdir -p data ; cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') + call execute_command_line('mkdir -p '//trim(OUTDIR)) open (10,file = trim(BCSDIR)//'/clsm/catchment.def', & form= 'formatted', action = 'read', status = 'old') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 index b24cb32c7..904693112 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/loss_during_day.f90 @@ -90,7 +90,7 @@ PROGRAM loss_during_day mult_jobs = .false. jseg = ntyps job=1 - I = iargc() + I = command_argument_count() if(I < 1 ) then print *, "Job Segment is not specified: ", i @@ -99,9 +99,9 @@ PROGRAM loss_during_day end if if (i>0) then - call getarg(1,arg) + call get_command_argument(1,arg) if ( trim(arg) == '-js' ) then - call getarg(2,arg) + call get_command_argument(2,arg) read(arg,'(i2)') job mult_jobs = .true. jseg =32 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs index a174aff89..bf9065677 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs @@ -51,11 +51,11 @@ if ( "$1" == "-noland" ) set SKIPLAND = YES if ( $HELPMODE != YES ) then - setenv NCPUS `/usr/bin/lscpu | grep '^CPU(s)' | cut -d ':' -f2 | head -1 ` - @ NCPUS = $NCPUS / 4 - @ NCPUS = $NCPUS * 3 + #setenv NCPUS `/usr/bin/lscpu | grep '^CPU(s)' | cut -d ':' -f2 | head -1 ` + #@ NCPUS = $NCPUS / 4 + #@ NCPUS = $NCPUS * 3 set NCPUS = 20 - setenv OMP_NUM_THREADS 1 + setenv OMP_NUM_THREADS 1 endif @@ -93,29 +93,33 @@ set lbcsv = NL3 if ( $HELPMODE != YES ) then echo "${CR}" - echo "Boundary Conditions (BCs) Package:" + echo "----------------------------------------------------------------------------------------------" + echo " Boundary Conditions (BCs) Package:" + echo "----------------------------------------------------------------------------------------------" + echo " " + echo "Enter 3-character alphanumeric code for land BCs version:" + echo "(Select only one.)" echo " " - echo "Enter 3-character alphanumeric code for land BCs version (select only one):" else echo "Options for land BCs version:" endif -echo " ${C2}F25 : Fortuna-2_5" -echo " ${C2}GM4 : Ganymed-4_0 (/discover/nobackup/ltakacs/bcs/Ganymed-4_0/)" -echo " ${C2}ICA : Icarus (/discover/nobackup/ltakacs/bcs/Icarus/)" -echo " ${C2}NL3 : Icarus-NLv3 (/discover/nobackup/ltakacs/bcs/Icarus-NLv3/)" -echo " ${C2}NL4 : NLv4 [SMAP] (/discover/nobackup/projects/gmao/smap/bcs_NLv4/NLv4/)" -echo " ${C2}NL5 : NLv5 [SMAP]" +echo " ${C2}F25 : Fortuna-2_5 (archived${CR}${C1}*${CR}${C2}: n/a)${CR}" +echo " ${C2}GM4 : Ganymed-4_0 (archived${CR}${C1}*${CR}${C2}: /discover/nobackup/ltakacs/bcs/Ganymed-4_0/)${CR}" +echo " ${C2}ICA : Icarus (archived${CR}${C1}*${CR}${C2}: /discover/nobackup/ltakacs/bcs/Icarus/)${CR}" +echo " ${C2}NL3 : Icarus-NLv3 (archived${CR}${C1}*${CR}${C2}: /discover/nobackup/ltakacs/bcs/Icarus-NLv3/)${CR}" +echo " ${C2}NL4 : NLv4 [SMAPL4] (archived${CR}${C1}*${CR}${C2}: /discover/nobackup/projects/gmao/smap/bcs_NLv4/NLv4/)${CR}" +echo " ${C2}NL5 : NLv5 [SMAPL4] (archived${CR}${C1}*${CR}${C2}: /discover/nobackup/projects/gmao/smap/SMAP_L4/L4_SM/bcs/CLSM_params/Icarus-NLv5_EASE/)${CR}" echo " ${C2}DEV : Development version${CR}" -echo " " -if ( $HELPMODE != YES ) then - echo " NOTE: Due to compiler differences, code improvements and bug fixes that" - echo " have taken place since the above archived BCs were created, some parameter" - echo " files produced by current source code may differ from those in the archived BCs." - echo " Nevertheless, the impact of these differences on science is insignificant and" - echo " the parameter files produced by current source code is considered to be" - echo " scientifically equivalent to the corresponding archived BCs" - echo " " - echo " OR press ENTER to select $lbcsv (current default).${CR}" +echo " " +if ( $HELPMODE != YES ) then + echo " ${C1} *BCs produced by this code will differ from BCs in archived directories\!\!\! ${CR}" + echo " These differences are caused by compiler changes, code improvements and bug" + echo " fixes that were implemented since the archived BCs in the above-mentioned" + echo " directories were originally created. The impact of these differences on" + echo " science is insignificant, and the parameter files produced by current" + echo " code are scientifically equivalent to the corresponding archived BCs." + echo " " + echo " OR press ENTER to select $lbcsv (current default).${CR}" echo " " endif @@ -133,7 +137,7 @@ if ( $HELPMODE != YES ) then $dummy == 'NL4' | \ $dummy == 'NL5' | \ $dummy == 'DEV') then - set lbcsv = $dummy + set lbcsv = $dummy else if ( $dummy == '' ) then echo $lbcsv else @@ -141,6 +145,7 @@ if ( $HELPMODE != YES ) then echo " ${C1} Invalid choice, try again:${CR}" goto LBCSV endif + endif ####################################################################### @@ -312,17 +317,34 @@ endif # Experiment directory (for BCS output) # define default -setenv EXPDIR /discover/nobackup/$USER/BCS_PACKAGE/$lbcsv/ +set EXPDIR = /discover/nobackup/$USER/BCS_PACKAGE/$lbcsv + +# append minor version string to default bcs output dir name if output from current code differs from archived bcs + +if( $lbcsv == 'F25' | \ + $lbcsv == 'GM4' | \ + $lbcsv == 'ICA' | \ + $lbcsv == 'NL3' | \ + $lbcsv == 'NL4' | \ + $lbcsv == 'NL5') then + set EXPDIR = $EXPDIR'_2/' + echo "----------------------------------------------------------------------------------------------" + echo " " + echo " ${C1} NOTE: $lbcsv BCs produced by this code will differ from BCs in archived directories\!\!\! ${CR}" + echo " ${C1} For clarity, '_[v]' was appended to the default output directory shown below.${CR}" +else + # just append trailing slash + set EXPDIR = $EXPDIR'/' +endif if ( $HELPMODE != YES ) then echo " " - echo "Enter desired BCS output directory (incl. full path)" - echo " or press ENTER to use the default:" + echo "Enter desired BCS output directory (incl. full path) or press ENTER to use the default:" echo " [${C2}${EXPDIR}${CR}]" set NEWEXPDIR = $< - if( $NEWEXPDIR != '' ) setenv EXPDIR $NEWEXPDIR + if( $NEWEXPDIR != '' ) set EXPDIR = $NEWEXPDIR mkdir -p $EXPDIR if ($status>0) then @@ -338,7 +360,7 @@ echo "" echo "${C1} Land BCs version:${CR} ${C2}$lbcsv${CR}" echo "${C1} Atmospheric resolution:${CR} ${C2}$HRCODES${CR}" echo "${C1} Ocean resolution:${CR} ${C2}$orslvs${CR}" -echo "${C1} Experiment directory:${CR} ${C2}$EXPDIR${CR}" +echo "${C1} Output directory:${CR} ${C2}$EXPDIR${CR}" ####################################################################### ####################################################################### @@ -1290,13 +1312,14 @@ cd ../ limit stacksize unlimited if ( $EVERSION == EASEv2 ) then setenv MASKFILE ${MASKFILE} -if(${MGRID} == M09 | ${MGRID} == M36) then - bin/mkLandRaster.x -x ${NX} -y ${NY} -v -t ${NT} - bin/mkSMAPTilesPara_v2.x -smap_grid ${MGRID} -pfaf_til T - bin/CombineRasters.x -f 0 -t 232000000 ${THISGRID} Pfafstetter > /dev/null - bin/CombineRasters.x -t 232000000 ${THISGRID} ${THISGRID}-Pfafstetter - /bin/mv til/${THISGRID}_${THISGRID}-Pfafstetter.til til/${THISGRID}_${THISGRID}-Pfafstetter.ind -endif +## This section was used to make Irrigated Tiles +##if(${MGRID} == M09 | ${MGRID} == M36) then +## bin/mkLandRaster.x -x ${NX} -y ${NY} -v -t ${NT} +## bin/mkSMAPTilesPara_v2.x -smap_grid ${MGRID} -pfaf_til T +## bin/CombineRasters.x -f 0 -t 232000000 ${THISGRID} Pfafstetter > /dev/null +## bin/CombineRasters.x -t 232000000 ${THISGRID} ${THISGRID}-Pfafstetter +## /bin/mv til/${THISGRID}_${THISGRID}-Pfafstetter.til til/${THISGRID}_${THISGRID}-Pfafstetter.ind +##endif setenv OMP_NUM_THREADS 1 bin/mkSMAPTilesPara_v2.x -smap_grid ${MGRID} -v $lbcsv setenv OMP_NUM_THREADS ${NCPUS} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 index fe035a9e5..c53cab991 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 @@ -43,7 +43,7 @@ PROGRAM mkCatchParam character*4 :: EASE =' ' character*2 :: DL ='DC' integer :: II, JJ, Type - integer :: I, J, iargc, nxt + integer :: I, J, command_argument_count, nxt real*8 :: dx, dy, lon0 logical :: regrid character(len=400), dimension (8) :: Usage @@ -99,8 +99,8 @@ PROGRAM mkCatchParam ! !$OMP ENDPARALLEL -! call system('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') -! call system('cd ..') +! call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') +! call execute_command_line('cd ..') USAGE(1) ="Usage: mkCatchParam -x nx -y ny -g Gridname -b DL -v LBCSV -e EASE " USAGE(2) =" -x: Size of longitude dimension of input raster. DEFAULT: 8640 " @@ -124,7 +124,7 @@ PROGRAM mkCatchParam write (log_file,'(a)')' ' endif - I = iargc() + I = command_argument_count() if(I < 1 .or. I > 10) then write (log_file,'(a)') "Wrong Number of arguments: ", i do j = 1,size(usage) @@ -134,13 +134,13 @@ PROGRAM mkCatchParam end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -168,10 +168,10 @@ PROGRAM mkCatchParam call exit(1) end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do - call getenv ("MASKFILE" ,MaskFile ) + call get_environment_variable ("MASKFILE" ,MaskFile ) if(trim(Gridname) == '') then write (log_file,'(a)')'Unable to create parameters without til/rst files.... !' @@ -663,7 +663,7 @@ PROGRAM mkCatchParam write (log_file,'(a)')'============================================================' write (log_file,'(a)')' ' - ! call system ('chmod 755 bin/create_README.csh ; bin/create_README.csh') + ! call execute_command_line ('chmod 755 bin/create_README.csh ; bin/create_README.csh') endif close (log_file,status='keep') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 index 6a73ac382..02c7c3c90 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCubeFVRaster.F90 @@ -27,7 +27,7 @@ program mkCubeFVRaster character*128 :: ARG, GridName='' character*1 :: opt integer :: ncells ! Cells on edges of cubed faces - integer :: I, J, N, status, iargc, nxt + integer :: I, J, N, status, command_argument_count, nxt integer :: js,jv real*8 :: dx, dy real*8, allocatable :: xs(:,:), ys(:,:), xv(:,:,:), yv(:,:,:) @@ -40,7 +40,7 @@ program mkCubeFVRaster ! Process Arguments !------------------ - I = iargc() + I = command_argument_count() if(I < 1 .or. I > 10) then print *, Usage @@ -48,14 +48,14 @@ program mkCubeFVRaster end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -80,7 +80,7 @@ program mkCubeFVRaster end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do read(arg,'(i6)') ncells diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 index d224fb777..99ad7b2a9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLISTilesPara.F90 @@ -13,7 +13,7 @@ PROGRAM mkLISTilesPara integer, parameter :: nc_gswp2 = 360, nr_gswp2 = 180, n_gswp2 =15238 integer, parameter :: max_pfaf_smap = 100 character(40) :: arg - integer :: i, N_args, iargc, status + integer :: i, N_args, command_argument_count, status character*300 :: latlon_vector_file integer :: nc, nr character*200 :: gfile @@ -23,7 +23,7 @@ PROGRAM mkLISTilesPara real :: dx, dy integer :: ncells, dateline, nc_domain,nr_domain,i_offset,j_offset - N_args = iargc() + N_args = command_argument_count() if(N_args /= 2) then print *,'USAGE : bin/mkLISTilesPara -vfile filename' @@ -36,11 +36,11 @@ PROGRAM mkLISTilesPara i = i+1 - call getarg(i,arg) + call get_command_argument(i,arg) if ( trim(arg) == '-vfile' ) then i = i+1 - call getarg(i,latlon_vector_file) + call get_command_argument(i,latlon_vector_file) else ! stop for any other arguments @@ -50,14 +50,14 @@ PROGRAM mkLISTilesPara endif end do -call system('mkdir -p data/ ; mkdir -p til/ ; mkdir -p rst/ ; mkdir -p clsm/plots') -call system('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') -call system('cd ..') +call execute_command_line('mkdir -p data/ ; mkdir -p til/ ; mkdir -p rst/ ; mkdir -p clsm/plots') +call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') +call execute_command_line('cd ..') ! Check for the 10 arc-sec MaskFile ! ----------------------------------- -call getenv ("MASKFILE" ,MaskFile ) +call get_environment_variable ("MASKFILE" ,MaskFile ) if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then ! Use new ESA based MaskFile @@ -87,7 +87,7 @@ PROGRAM mkLISTilesPara tmpstring = 'bin/mkCatchParam.x '//trim(tmpstring2)//' '//trim(tmpstring1) print *,trim(tmpstring) -call system(tmpstring) +call execute_command_line(tmpstring) contains diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 index 3af0ff1a6..f42a5adc0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLandRaster.F90 @@ -22,7 +22,7 @@ Program MakeLandRaster integer, parameter :: nx0 = 8640 integer, parameter :: ny0 = 4320 - integer :: IARGC + integer :: command_argument_count integer :: i,j,k,n, status,ncid, ncid2 integer :: ip, nxt integer :: type, maxtiles, nx, ny @@ -73,8 +73,8 @@ Program MakeLandRaster character*128 :: & Usage = "mkLandRaster -x nx -y ny -v -h -z -t maxtiles -l LandFile -g GridName" include 'netcdf.inc' - call system('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call system('cd ..') + call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') + call execute_command_line('cd ..') ! Process Arguments !------------------ @@ -90,7 +90,7 @@ Program MakeLandRaster InputFile = & "data/CATCH/global.cat_id.catch.DL" - I = iargc() + I = command_argument_count() if(I > 13) then print *, "Wrong Number of arguments: ", i @@ -101,7 +101,7 @@ Program MakeLandRaster nxt = 1 do while(nxt<=I) - call getarg(nxt,arg) + call get_command_argument(nxt,arg) if(arg(1:1)/='-') then print *, trim(Usage) call exit(1) @@ -110,7 +110,7 @@ Program MakeLandRaster if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end if else arg = arg(3:) @@ -143,7 +143,7 @@ Program MakeLandRaster ! Check for the 10 arc-sec MaskFile (SM) - call getenv ("MASKFILE" ,MaskFile ) + call get_environment_variable ("MASKFILE" ,MaskFile ) print *,'Using Mask file : ',trim(MaskFile) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 index c7bb5bce2..6812a6bfe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkLatLonRaster.F90 @@ -59,7 +59,7 @@ program mkLatLonRaster integer :: II, JJ, Type logical :: UseType = .false., DoZip=.false., Verb=.false. logical :: Here = .false. - integer :: I, J, status, iargc, nxt + integer :: I, J, status, command_argument_count, nxt real*8 :: dx, dy, lon0 real*8, allocatable :: xs(:), ys(:), xv(:,:,:), yv(:,:,:) character*128 :: & @@ -68,7 +68,7 @@ program mkLatLonRaster ! Process Arguments !------------------ - I = iargc() + I = command_argument_count() if(I < 2 .or. I > 17) then print *, "Wrong Number of arguments: ", i @@ -77,13 +77,13 @@ program mkLatLonRaster end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -113,13 +113,13 @@ program mkLatLonRaster call exit(1) end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do read(arg,'(i5)') ii nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) read(arg,'(i5)') jj diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 index 18a5a6889..5dd4732e8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMITAquaRaster.F90 @@ -12,7 +12,7 @@ program MAIN integer, parameter :: RKIND = 8 integer, parameter :: LL = 1, LR = 2, UR = 3, UL = 4 - integer :: iargc + integer :: command_argument_count integer :: Nc = 8640, NR = 4320 type Ptr2 @@ -44,7 +44,7 @@ program MAIN ! Get source grid directory and destination raster file names !------------------------------------------------------------ - i = iargc() + i = command_argument_count() if(I < 2 .or. i > 7) then print *, "Wrong Number of arguments: ", i @@ -53,13 +53,13 @@ program MAIN end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zv')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -79,7 +79,7 @@ program MAIN call exit(1) end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do GridDir = arg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 index fcb9a96e9..7e6fbe4ea 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkMOMAquaRaster.F90 @@ -19,7 +19,7 @@ program MOMraster REAL_, pointer :: yvert(:,:,:) ! Lats of MOM's vertices REAL_ :: xmin, xmax integer :: i, j, nxt,k - integer :: status, iargc + integer :: status, command_argument_count character*(128) :: GridFile character*(128) :: GridName='' character*(128) :: arg @@ -40,7 +40,7 @@ program MOMraster ! Process Arguments !------------------ - I = iargc() + I = command_argument_count() if(I < 1 .or. I > 8) then print *, "Wrong Number of arguments: ", i @@ -49,13 +49,13 @@ program MOMraster end if nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -78,7 +78,7 @@ program MOMraster call exit(1) end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do GridFile = arg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 index 2f5f4f7c6..fc62e7718 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara.F90 @@ -52,7 +52,7 @@ PROGRAM mkSMAPTilesPara_v1 character*100 :: veg_class (12) character*5 :: MGRID character*100 :: gfile,gtopo30 - integer :: nc_smap,nr_smap, N_args, iargc + integer :: nc_smap,nr_smap, N_args, command_argument_count real :: EASE_grid_area, CELL_km REAL :: dx,dy,d2r,lats,mnx,mxx,mny,mxy,sum1,sum2,jgv, VDUM,pix_area character(40) :: arg @@ -61,7 +61,7 @@ PROGRAM mkSMAPTilesPara_v1 character*128 :: MaskFile include 'netcdf.inc' - N_args = iargc() + N_args = command_argument_count() if(N_args < 1) then print *,'USAGE : bin/mkSMAPTiles_v1 -smap_grid MXX' @@ -75,11 +75,11 @@ PROGRAM mkSMAPTilesPara_v1 i = i+1 - call getarg(i,arg) + call get_command_argument(i,arg) if ( trim(arg) == '-smap_grid' ) then i = i+1 - call getarg(i,MGRID) + call get_command_argument(i,MGRID) else ! stop for any other arguments @@ -91,8 +91,8 @@ PROGRAM mkSMAPTilesPara_v1 end do - call system('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call system('cd ..') + call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') + call execute_command_line('cd ..') ! Setting SMAP Grid specifications @@ -127,7 +127,7 @@ PROGRAM mkSMAPTilesPara_v1 ! Check for the 10 arc-sec MaskFile ! ----------------------------------- - call getenv ("MASKFILE" ,MaskFile ) + call get_environment_variable ("MASKFILE" ,MaskFile ) print *, 'Using MaskFile ', trim(MaskFile) @@ -690,7 +690,7 @@ PROGRAM mkSMAPTilesPara_v1 tmpstring = 'bin/mkCatchParam.x '//trim(tmpstring2)//' '//trim(tmpstring1) print *,trim(tmpstring) - call system (tmpstring) + call execute_command_line (tmpstring) END PROGRAM mkSMAPTilesPara_v1 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 index 79ec28562..70025ec11 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkSMAPTilesPara_v2.F90 @@ -56,7 +56,7 @@ PROGRAM mkSMAPTilesPara_v2 character*100 :: veg_class (12) character*5 :: MGRID character*100 :: gfile,gtopo30 - integer :: nc_smap,nr_smap, N_args, iargc + integer :: nc_smap,nr_smap, N_args, command_argument_count real :: EASE_grid_area, CELL_km REAL :: dx,dy,d2r,lats,mnx,mxx,mny,mxy,sum1,sum2,jgv, VDUM,pix_area character(40) :: arg, EASElabel @@ -68,7 +68,7 @@ PROGRAM mkSMAPTilesPara_v2 include 'netcdf.inc' - N_args = iargc() + N_args = command_argument_count() if(N_args < 1) then print *,'USAGE : bin/mkSMAPTiles -smap_grid MXX' @@ -82,20 +82,20 @@ PROGRAM mkSMAPTilesPara_v2 i = i+1 - call getarg(i,arg) + call get_command_argument(i,arg) if ( trim(arg) == '-smap_grid' ) then i = i+1 - call getarg(i,MGRID) + call get_command_argument(i,MGRID) elseif ( trim(arg) == '-pfaf_til' ) then i = i+1 - call getarg(i,PF) + call get_command_argument(i,PF) if (PF == 'T') pfaf_til = .true. elseif ( trim(arg) == '-v' ) then i = i+1 - call getarg(i,LBSV) + call get_command_argument(i,LBSV) else ! stop for any other arguments @@ -107,8 +107,8 @@ PROGRAM mkSMAPTilesPara_v2 end do - call system('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') - call system('cd ..') + call execute_command_line('cd data/ ; ln -s /discover/nobackup/projects/gmao/ssd/land/l_data/LandBCs_files_for_mkCatchParam/V001/ CATCH') + call execute_command_line('cd ..') ! Setting SMAP Grid specifications @@ -184,7 +184,7 @@ PROGRAM mkSMAPTilesPara_v2 ! Check for the 10 arc-sec MaskFile ! ----------------------------------- - call getenv ("MASKFILE" ,MaskFile ) + call get_environment_variable ("MASKFILE" ,MaskFile ) print *, 'Using MaskFile ', trim(MaskFile) @@ -194,8 +194,9 @@ PROGRAM mkSMAPTilesPara_v2 nr = 21600 call mkEASEv2Raster - else - if((trim(MGRID) == 'M09').or.(trim(MGRID) == 'M36'))call write_tilfile + !else + ! This section was used to make Irrigated Tiles + ! if((trim(MGRID) == 'M09').or.(trim(MGRID) == 'M36'))call write_tilfile endif if (index(MaskFile,'GEOS5_10arcsec_mask') /= 0) then @@ -749,8 +750,6 @@ PROGRAM mkSMAPTilesPara_v2 ! CALL CREATE_ROUT_PARA_FILE (NC, NR, trim(gfile), MGRID=MGRID) - call system (tmpstring) - ! now run mkCatchParam ! -------------------- @@ -759,7 +758,7 @@ PROGRAM mkSMAPTilesPara_v2 tmpstring = 'bin/mkCatchParam.x '//trim(tmpstring2)//' '//trim(tmpstring1) print *,trim(tmpstring) - call system (tmpstring) + call execute_command_line (tmpstring) contains @@ -776,8 +775,8 @@ SUBROUTINE mkEASEv2Raster allocate (xs ( nc_smap+1, nr_smap+1)) allocate (ys ( nc_smap+1, nr_smap+1)) - do j = 1, nr_smap - do i = 1, nc_smap + do j = 1, nr_smap+1 + do i = 1, nc_smap+1 x = real(i-1) -0.5 y = real(nr_smap - j)+0.5 call easeV2_inverse(MGRID, x, y, yout, xout) @@ -785,31 +784,9 @@ SUBROUTINE mkEASEv2Raster xs (i,j) = dble(xout) end do end do - - do j = nr_smap + 1, nr_smap + 1 - do i = nc_smap + 1, nc_smap + 1 - x = real(i-1) -0.5 - y = -0.5 - call easeV2_inverse(MGRID, x, y, yout, xout) - ys (i,j) = dble(yout) - xs (i,j) = dble(xout) - end do - end do + + call LRRasterize(EASElabel,xs,ys,nc=nc,nr=nr,xmn = xs(1,1), xmx= xs(nc_smap+1, nr_smap+1), ymn=ys(1,1), ymx = ys(nc_smap+1, nr_smap+1), Here=.false., Verb=.false.) - where (ys > 90.) - ys = 90.D0 - endwhere - where (ys < -90.) - ys = -90.D0 - endwhere - where (xs > 180.) - xs = 180.D0 - endwhere - where (xs < -180.) - xs = -180.D0 - endwhere - - call LRRasterize(EASElabel,xs,ys,nc=nc,nr=nr,Here=.false., Verb=.false.) stop end SUBROUTINE mkEASEv2Raster diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 index f69829259..c097f69bc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mk_runofftbl.F90 @@ -18,7 +18,7 @@ program Runoff character*100 :: fileLL="data/CATCH/Outlet_latlon." character*5 :: C_NX, C_NY - call getarg(1,file) + call get_command_argument(1,file) fileT = "til/"//trim(file)//".til" fileR = "rst/"//trim(file)//".rst" diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 index a75036635..0522879c4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 @@ -1139,7 +1139,7 @@ SUBROUTINE create_mapping (nc,nr,nc_data,nr_data,rmap, gfile) allocate(iraster(nc_data,nr_data),stat=STATUS); VERIFY_(STATUS) call RegridRaster(tile_id,iraster) NPLUS = count(iraster >= 1 .and. iraster <= ncatch) - allocate (rmap%ij_index(1:nc_data, 1:nr_data)) + allocate (rmap%ij_index(1:nc_data, 1:nr_data), source = 0) allocate (rmap%map (1:NPLUS)) rmap%map%NT = 0 pix_count = 1 @@ -1158,7 +1158,7 @@ SUBROUTINE create_mapping (nc,nr,nc_data,nr_data,rmap, gfile) else NPLUS = count(tile_id >= 1 .and. tile_id <= ncatch) - allocate (rmap%ij_index(1:nc_data, 1:nr_data)) + allocate (rmap%ij_index(1:nc_data, 1:nr_data), source = 0) allocate (rmap%map (1:NPLUS)) rmap%map%NT = 0 pix_count = 1 @@ -1393,15 +1393,15 @@ SUBROUTINE modis_scale_para_high (ease_grid,MA,gfile) character*6 :: MA CHARACTER*20 :: version,resoln,continent integer :: nc_gcm,nr_gcm,nc_ocean,nr_ocean - REAL :: latt,lont,fr_gcm,fr_cat,tsteps,zth, slr,tarea - INTEGER :: typ,pfs,ig,jg,j_dum,ierr,indx_dum,indr1,indr2,indr3 ,ip2 + REAL :: tsteps,zth, slr,tarea + INTEGER :: typ,j_dum,ierr,indr1,ip2 character*100 :: path,fname,fout,metpath character (*) :: gfile integer :: n,maxcat,ip integer :: yy,j,month integer, allocatable, dimension (:) :: vegcls real, allocatable, dimension (:) :: & - modisvf, modisnf,albvf,albnf, lat,lon, & + modisvf, modisnf,albvf,albnf, & green,lai,lai_before,lai_after,grn_before,grn_after real, allocatable, dimension (:) :: & calbvf,calbnf, zero_array, one_array, albvr,albnr @@ -1435,8 +1435,8 @@ SUBROUTINE modis_scale_para_high (ease_grid,MA,gfile) close (10,status='keep') fname=trim(gfile)//'.til' - open (10,file=fname,status='old',action='read',form='formatted') + fname='clsm/mosaic_veg_typs_fracs' open (20,file=fname,status='old',action='read',form='formatted') @@ -1451,15 +1451,17 @@ SUBROUTINE modis_scale_para_high (ease_grid,MA,gfile) do n = 1,ip if (ease_grid) then - read(10,*,IOSTAT=ierr) typ,pfs,lon,lat,ig,jg,fr_gcm + read(10,*,IOSTAT=ierr) typ !,pfs,lont,latt,ig,jg,fr_gcm else - read(10,'(I10,3E20.12,9(2I10,E20.12,I10))',IOSTAT=ierr) & - typ,tarea,lont,latt,ig,jg,fr_gcm,indx_dum,pfs,j_dum,fr_cat,j_dum + !read(10,'(I10,3E20.12,9(2I10,E20.12,I10))',IOSTAT=ierr) & + ! typ,tarea,lont,latt,ig,jg,fr_gcm,indx_dum,pfs,j_dum,fr_cat,j_dum + read(10,*,IOSTAT=ierr) typ endif if (typ == 100) then ip2 = n - read (20,'(i10,i8,2(2x,i3),2(2x,f6.4))') & - indr1,indr1,vegcls(ip2),indr1,fr_gcm,fr_gcm + !read (20,'(i10,i8,2(2x,i3),2(2x,f6.4))') & + ! indr1,indr1,vegcls(ip2),indr1,fr_gcm,fr_gcm + read (20,*,IOSTAT=ierr) indr1,indr1,vegcls(ip2) endif if(ierr /= 0)write (*,*)'Problem reading', n, ease_grid end do @@ -1875,6 +1877,7 @@ SUBROUTINE modis_alb_on_tiles_high (nc_data,nr_data,rmap,MA,gfiler) do j = jLL,jLL + nr_10 -1 do i = iLL, iLL + nc_10 -1 pix_count = rmap%ij_index(i,j) + if (pix_count ==0) cycle if(net_data1(i-iLL +1 ,j - jLL +1) > 0) then if(rmap%map(pix_count)%nt > 0) then @@ -2603,6 +2606,7 @@ SUBROUTINE hres_lai_no_gswp (nc_data,nr_data,rmap,gfiler,lai_name, merge) do i = iLL, iLL + nc_10 -1 if(net_data1(i-iLL +1 ,j - jLL +1) /= d_undef) then pix_count = rmap%ij_index(i,j) + if (pix_count ==0) cycle if(rmap%map(pix_count)%nt > 0) then do n = 1, rmap%map(pix_count)%nt if(vec_lai(rmap%map(pix_count)%tid(n)) == -9999.) vec_lai(rmap%map(pix_count)%tid(n)) = 0. @@ -2906,6 +2910,7 @@ SUBROUTINE hres_gswp2 (nc_data,nr_data,rmap, gfiler,lai_name,merge) do i = iLL, iLL + nc_10 -1 if(net_data1(i-iLL +1 ,j - jLL +1) /= d_undef) then pix_count = rmap%ij_index(i,j) + if (pix_count == 0) cycle if(rmap%map(pix_count)%nt > 0) then do n = 1, rmap%map(pix_count)%nt if(vec_lai(rmap%map(pix_count)%tid(n)) == -9999.) vec_lai(rmap%map(pix_count)%tid(n)) = 0. @@ -4194,8 +4199,13 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) j = 0 i1 = n - k i2 = n + k - if((i1 >= 1).and.(soil_class_com (i1) >=1)) j = i1 ! tentatively use "lower" neighbor unless out of range - if((i2 <=maxcat).and.(soil_class_com (i2) >=1)) j = i2 ! "upper" neighbor prevails unless out of range + if(i1 >= 1) then + if (soil_class_com (i1) >=1) j = i1 ! tentatively use "lower" neighbor unless out of range + endif + + if(1 <= i2 .and. i2 <=maxcat) then + if (soil_class_com (i2) >=1) j = i2 ! "upper" neighbor prevails unless out of range + endif if (j > 0) then soil_class_com (n) = soil_class_com (j) @@ -5915,9 +5925,9 @@ SUBROUTINE open_landparam_nc4_files(N_tile) write (time_stamp,'(i4.4,a1,i2.2,a1,i2.2,1x,a2,1x,i2.2,a1,i2.2,a1,i2.2)') & date_time_values(1),'-',date_time_values(2),'-',date_time_values(3),'at', & date_time_values(5),':',date_time_values(6),':',date_time_values(7) -! call system('setenv MYNAME `finger $USER | cut -d: -f3 | head -1`') +! call execute_command_line('setenv MYNAME `finger $USER | cut -d: -f3 | head -1`') ! call sleep (5) - call getenv ("USER" ,MYNAME ) + call get_environment_variable ("USER" ,MYNAME ) status = NF_PUT_ATT_TEXT(NCCatOUTID , NF_GLOBAL, 'CreatedBy', LEN_TRIM(MYNAME), trim(MYNAME) ) status = NF_PUT_ATT_TEXT(NCCatOUTID , NF_GLOBAL, 'Date' , LEN_TRIM(time_stamp),trim(time_stamp)) status = NF_PUT_ATT_TEXT(NCVegOUTID , NF_GLOBAL, 'CreatedBy', LEN_TRIM(MYNAME), trim(MYNAME) ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index fd381b50c..57092add8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -950,10 +950,10 @@ SUBROUTINE remove_tiny_tiles ( & print *,trim(gname) string1 ='til/'//trim(gout)//'-Pfafstetter.til'//' '//& 'clsm/'//trim(gout)//'-Pfaf.notiny.til' - call system ('cp '//trim(string1)) + call execute_command_line ('cp '//trim(string1)) string1 ='rst/'//trim(gout)//'-Pfafstetter.rst'//' '//& 'clsm/'//trim(gout)//'-Pfaf.notiny.rst' - call system ('cp '//trim(string1)) + call execute_command_line ('cp '//trim(string1)) print *,'and, copied those those files to clsm/.' stop @@ -2726,9 +2726,9 @@ SUBROUTINE cti_stat_file (ease_grid,gfile, MaskFile) do n = 1,ip if (ease_grid) then - read(10,*,IOSTAT=ierr) typ,pfs,lon,lat,ig,jg,fr_gcm,i_dum + read(10,*,IOSTAT=ierr) typ,pfs !,lon,lat,ig,jg,fr_gcm,i_dum else - read(10,'(I10,3E20.12,9(2I10,E20.12,I10))',IOSTAT=ierr) & + read(10,'(I10,3E20.12,9(2I10,E20.12,I10))',IOSTAT=ierr) & typ,tarea,lon,lat,ig,jg,fr_gcm,indx_dum,pfs,i_dum,fr_cat,j_dum endif @@ -6215,9 +6215,9 @@ SUBROUTINE FUNCIDEP( & endif enddo locmax=MAX(3,indimax10) - - endif ! if (nmax .ge. shift+1) - + ! add protection here in case nmax <3 . why 3 ? + if (locmax > nmax) locmax = nmax + endif ! if (nmax .ge. shift+1) 30 densmax=denstest(idep,locmax) aa(idep)=exp(1.)*densmax @@ -6441,10 +6441,10 @@ SUBROUTINE FUNCZBAR( & densaux(n) .gt. densaux(n-11) .and. & densaux(n) .gt. densaux(n-12) .and. & densaux(n) .gt. densaux(n-13) .and. & - densaux(n) .gt. densaux(n-14) .and. & - densaux(n) .gt. densaux(n-15)) then - locmax=n - goto 30 + densaux(n) .gt. densaux(n-14)) then ! .and. & + !densaux(n) .gt. densaux(n-15)) then + locmax=n + goto 30 endif enddo @@ -6459,7 +6459,8 @@ SUBROUTINE FUNCZBAR( & endif enddo locmax=MAX(3,indimax10) - + ! in case nmax < 3. why hard coded 3? + if(locmax > nmax) locmax = nmax endif ! if (nmax .ge. shift+1) 30 densmax=denstest(locmax) @@ -7250,11 +7251,11 @@ SUBROUTINE REFORMAT_VEGFILES integer :: month tmp_string = 'mkdir -p '//'clsm/g5fmt' - call system(tmp_string) + call execute_command_line(tmp_string) tmp_string = '/bin/mv '//'clsm/lai.dat ' //'clsm/g5fmt/.' - call system(tmp_string) + call execute_command_line(tmp_string) tmp_string = '/bin/mv '//'clsm/green.dat ' //'clsm/g5fmt/.' - call system(tmp_string) + call execute_command_line(tmp_string) open (10,file='clsm/g5fmt/lai.dat' , form = 'unformatted', & convert='little_endian',status='old',action='read' ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 index af4840159..dfbad30e7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyTiles.F90 @@ -52,7 +52,7 @@ PROGRAM rmTinyTiles integer :: II, JJ, Type logical :: UseType = .false., DoZip=.false., Verb=.false. logical :: Here = .false. - integer :: I, J, status, iargc, nxt + integer :: I, J, status, command_argument_count, nxt real*8 :: dx, dy, lon0 real*8, allocatable :: xs(:), ys(:) character*128 :: & @@ -69,7 +69,7 @@ PROGRAM rmTinyTiles ! Process Arguments !------------------ - I = iargc() + I = command_argument_count() if(I < 2 .or. I > 17) then print *, "Wrong Number of arguments: ", i @@ -79,14 +79,14 @@ PROGRAM rmTinyTiles nxt = 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) do while(arg(1:1)=='-') opt=arg(2:2) if(len(trim(arg))==2) then if(scan(opt,'zvh')==0) then nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) endif else arg = arg(3:) @@ -116,18 +116,18 @@ PROGRAM rmTinyTiles call exit(1) end select nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) end do read(arg,'(i5)') ii nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) read(arg,'(i5)') jj nxt = nxt + 1 - call getarg(nxt,arg) + call get_command_argument(nxt,arg) Grid2 = ARG if(trim(Gridname) == '') then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 index e74175d91..16eab40d7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 @@ -7,6 +7,7 @@ program SaltIntSplitter use MAPL use mk_restarts_getidsMod, only: ReadTileFile_IntLatLon use gFTL_StringVector + use gFTL_StringIntegerMap implicit none @@ -47,6 +48,11 @@ program SaltIntSplitter integer :: filetype,nVars character*256 :: Iam = "SaltIntSplitter" integer :: status + type (Variable), pointer :: global + type (StringIntegerMap), pointer :: dimensions + type (StringIntegerMap) :: water_dimensions + type (StringIntegerMapIterator) :: d_iter + !--------------------------------------------------------------------------- I = iargc() @@ -71,10 +77,10 @@ program SaltIntSplitter itiles = size(loni) ! Input Tile Size - allocate( varIn(itiles) ) - allocate( varOut(itiles) ) - allocate( varInR8(itiles) ) - allocate( varOutR8(itiles) ) + allocate( varIn(itiles), source = 0. ) + allocate( varOut(itiles), source = 0. ) + allocate( varInR8(itiles), source = 0.d0 ) + allocate( varOutR8(itiles),source = 0.d0 ) call MAPL_NCIOGetFileType(InRestart, filetype,rc=rc) @@ -95,20 +101,86 @@ program SaltIntSplitter ungridSize = 0 end if - if ( (subtileSize==0) .and. (ungridSize==0)) then - call MAPL_IOChangeRes(InCfg,WaterCfg,['tile'],[itiles],rc=rc) - call MAPL_IOChangeRes(InCfg,IceCfg,['tile'],[itiles],rc=rc) - else if ((subtileSize/=0) .and. (ungridSize==0)) then - call MAPL_IOChangeRes(InCfg,WaterCfg,['tile ','subtile'],[itiles,1],rc=rc) - call MAPL_IOChangeRes(InCfg,IceCfg,['tile ','subtile'],[itiles,subtileSize-1],rc=rc) - else if ((subtileSize==0) .and. (ungridSize/=0)) then - call MAPL_IOChangeRes(InCfg,WaterCfg,['tile ','unknown_dim4'],[itiles,ungridSize-1],rc=rc) - call MAPL_IOChangeRes(InCfg,IceCfg,['tile ','unknown_dim4'],[itiles,ungridSize-1],rc=rc) - else if ((subtileSize/=0) .and. (ungridSize/=0)) then - call MAPL_IOChangeRes(InCfg,WaterCfg,['tile ','subtile ','unknown_dim4'],[itiles,1,ungridSize-1],rc=rc) - call MAPL_IOChangeRes(InCfg,IceCfg,['tile ','subtile ','unknown_dim4'],[itiles,subtileSize-1,ungridSize-1],rc=rc) + dimensions => InCfg%get_dimensions() + global => Incfg%get_global_var() + IceCfg = FileMetaData(dimensions= dimensions, global=global) + + water_dimensions = dimensions + d_iter = water_dimensions%find('unknown_dim1') + if (d_iter /= water_dimensions%end()) call water_dimensions%erase(d_iter) + d_iter = water_dimensions%find('unknown_dim2') + if (d_iter /= water_dimensions%end()) call water_dimensions%erase(d_iter) + d_iter = water_dimensions%find('unknown_dim3') + if (d_iter /= water_dimensions%end()) call water_dimensions%erase(d_iter) + d_iter = water_dimensions%find('unknown_dim4') + if (d_iter /= water_dimensions%end()) call water_dimensions%erase(d_iter) + + WaterCfg = FileMetaData(dimensions= water_dimensions, global=global) + + call WaterCfg%modify_dimension('tile', itiles) + call IceCfg%modify_dimension('tile', itiles) + + if ((subtileSize/=0) .and. (ungridSize==0)) then + call WaterCfg%modify_dimension('subtile', 1) + call IceCfg%modify_dimension('subtile', subtileSize-1) + endif + + if((subtileSize==0) .and. (ungridSize/=0)) then + call IceCfg%modify_dimension('unknown_dim4', ungridSize-1) + endif + + if ((subtileSize/=0) .and. (ungridSize/=0)) then + call IceCfg%modify_dimension('unknown_dim4', ungridSize-1) + call WaterCfg%modify_dimension('subtile', 1) + call IceCfg%modify_dimension('subtile', subtileSize-1) end if + + !######################################## + + variables => InCfg%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) + var_name => var_iter%key() + myVariable => var_iter%value() + var_dimensions => myVariable%get_dimensions() + ndims = var_dimensions%size() + dataType = myVariable%get_type() + if (.not.InCfg%is_coordinate_variable(var_name)) then + if (ndims == 1) then + select case (var_name) + case ('HSKINI','SSKINI','TSKINI', 'SLMASK') ! sea ice vars + call IceCfg%add_variable(var_name, myVariable) + case default + call WaterCfg%add_variable(var_name, myVariable) + end select + else if (ndims == 2) then + dname => myVariable%get_ith_dimension(2) + dimSizes(2)=InCfg%get_dimension(dname) + call iceCfg%add_variable(var_name, myVariable) + if (dataType /= pFIO_REAL64) then ! R8 vars only from coupled + if (dimSizes(2) == 2) then ! AMIP + call waterCfg%add_variable(var_name, myVariable) + else + if (var_name /= 'TSKINI' .and. var_name /= 'TAUAGE') then + call waterCfg%add_variable(var_name, myVariable) + endif + endif + endif + ! for coupled rst, water=1, ice=2,num_subtiles + else if (ndims == 3) then + call iceCfg%add_variable(var_name, myVariable) + end if + end if + + if (var_name == 'time') then + call iceCfg%add_variable(var_name, myVariable) + call waterCfg%add_variable(var_name, myVariable) + endif + call var_iter%next() + enddo + +!#################### i = index(InRestart,'/',back=.true.) WaterFileName = "OutData/openwater_internal_rst" @@ -118,7 +190,6 @@ program SaltIntSplitter call IceFmt%create(IceFileName,rc=rc) call IceFmt%write(IceCfg,rc=rc) - variables => InCfg%get_variables() var_iter = variables%begin() do while (var_iter /= variables%end()) @@ -170,7 +241,7 @@ program SaltIntSplitter call MAPL_VarRead(InFmt,var_name,varIn,offset1=2, __RC__) call MAPL_VarWrite(WaterFmt,var_name,varIn,offset1=1) else - if (var_name == 'TSKINI') then + if (var_name == 'TSKINI' .or. var_name == 'TAUAGE') then do j=1,dimSizes(2) call MAPL_VarRead(InFmt,var_name,varIn,offset1=j, __RC__) call MAPL_VarWrite(IceFmt,var_name,varIn,offset1=j) @@ -204,6 +275,11 @@ program SaltIntSplitter enddo end if end if + + if (var_name == 'time') then + call MAPL_VarWrite(IceFmt, 'time',[0.0d0]) + call MAPL_VarWrite(waterFmt,'time',[0.0d0]) + endif call var_iter%next() enddo @@ -260,7 +336,7 @@ program SaltIntSplitter ! ---------------------------------------------- do n=1,ntot nsubtiles = nrecs(n)/itiles - allocate( var2(itiles,nsubtiles) ) + allocate( var2(itiles,nsubtiles), source = 0. ) read (50) var2 if( nsubtiles.eq.1 ) then print *, 'Writing Tile_Only Data ...'