model/src/ini_global_domain.F

aa03c27196 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
                0005 C     !ROUTINE: INI_GLOBAL_DOMAIN
                0006 C     !INTERFACE:
                0007       SUBROUTINE INI_GLOBAL_DOMAIN( myThid )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE INI_GLOBAL_DOMAIN
                0012 C     | o Initialise domain (i.e., where there is fluid)
                0013 C     |   related (global) quantities.
                0014 C     |   Called after grid and masks are set (ini_grid,
                0015 C     |   ini_masks) or modified (packages_init_fixed call).
                0016 C     *==========================================================*
                0017 C     | Compute global domain Area ;
                0018 C     *==========================================================*
                0019 C     \ev
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023 C     === Global variables ===
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028 #ifdef ALLOW_EXCH2
                0029 # include "W2_EXCH2_SIZE.h"
                0030 # include "W2_EXCH2_TOPOLOGY.h"
                0031 #endif /* ALLOW_EXCH2 */
                0032
                0033 C     !INPUT/OUTPUT PARAMETERS:
b15f6f1e9f Jean*0034 C     myThid  :: my Thread Id number
aa03c27196 Jean*0035       INTEGER myThid
                0036
                0037 C     == Local variables in common ==
b15f6f1e9f Jean*0038       _RL tileArea(nSx,nSy)
aa03c27196 Jean*0039 C     put tileArea in (local) common block to print from master-thread:
                0040       COMMON / LOCAL_INI_GLOB_DOMAIN / tileArea
                0041
                0042 C     !LOCAL VARIABLES:
b15f6f1e9f Jean*0043 C     bi, bj  :: tile indices
                0044 C     i, j, k :: Loop counters
aa03c27196 Jean*0045       INTEGER bi, bj
b15f6f1e9f Jean*0046       INTEGER i, j, k, nCorners
aa03c27196 Jean*0047       LOGICAL northWestCorner, northEastCorner,
                0048      &        southWestCorner, southEastCorner
b15f6f1e9f Jean*0049       _RL loc2dArea, loc2dNwet
                0050       _RL loc3dArea, loc3dNwet
                0051       _RL tileNwet(nSx,nSy)
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
aa03c27196 Jean*0053 #ifdef ALLOW_EXCH2
                0054       INTEGER myTile
                0055 #endif /* ALLOW_EXCH2 */
                0056 CEOP
                0057
                0058 C--   Initialisation
                0059
                0060 #ifdef NONLIN_FRSURF
                0061 C--   Save initial geometrical hFac factor into h0Fac (fixed in time):
                0062 C     better here (after packages_init_fixed call) than in INI_MASKS_ETC
                0063 C     in case 1 pkg would need to modify them.
                0064 C    <= moved to INI_MASK_ETC , despite comment above, since:
                0065 C      a) in case 1 pkg is changing hFac, this pkg should also update h0Fac
                0066 C      b) pkg/shelfice does modify hFac but done directly within ini_masks_etc
                0067 #endif /* NONLIN_FRSURF */
                0068
                0069 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0070
                0071 C--   Calculate global domain area:
                0072 C     use to be in ini_masks_etc.F but has been move after packages_init_fixed
                0073 C     in case 1 pkg (e.g., OBCS) modifies the domain size.
                0074       DO bj = myByLo(myThid), myByHi(myThid)
                0075        DO bi = myBxLo(myThid), myBxHi(myThid)
                0076 C-      Compute the domain Area:
b15f6f1e9f Jean*0077         tileNwet(bi,bj) = 0. _d 0
aa03c27196 Jean*0078         tileArea(bi,bj) = 0. _d 0
                0079         DO j=1,sNy
                0080          DO i=1,sNx
b15f6f1e9f Jean*0081           tileNwet(bi,bj) = tileNwet(bi,bj) + maskInC(i,j,bi,bj)
aa03c27196 Jean*0082           tileArea(bi,bj) = tileArea(bi,bj)
                0083      &                    + rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
                0084          ENDDO
                0085         ENDDO
                0086        ENDDO
                0087       ENDDO
b15f6f1e9f Jean*0088       CALL GLOBAL_SUM_TILE_RL( tileNwet, loc2dNwet, myThid )
                0089       CALL GLOBAL_SUM_TILE_RL( tileArea, loc2dArea, myThid )
                0090
                0091 C--   Calculate domain 3-D average grid-cell area:
                0092       DO bj = myByLo(myThid), myByHi(myThid)
                0093        DO bi = myBxLo(myThid), myBxHi(myThid)
                0094 C-      Compute 3-D integrated area:
                0095         tileNwet(bi,bj) = 0. _d 0
                0096         tileArea(bi,bj) = 0. _d 0
                0097         DO k=1,Nr
                0098          DO j=1,sNy
                0099           DO i=1,sNx
                0100            tileNwet(bi,bj) = tileNwet(bi,bj)
                0101      &                     + maskC(i,j,k,bi,bj)*maskInC(i,j,bi,bj)
                0102            tileArea(bi,bj) = tileArea(bi,bj)
                0103      &                     + deepFac2C(k)*rA(i,j,bi,bj)
                0104      &                      *maskC(i,j,k,bi,bj)*maskInC(i,j,bi,bj)
                0105           ENDDO
                0106          ENDDO
                0107         ENDDO
                0108        ENDDO
                0109       ENDDO
                0110       CALL GLOBAL_SUM_TILE_RL( tileNwet, loc3dNwet, myThid )
                0111       CALL GLOBAL_SUM_TILE_RL( tileArea, loc3dArea, myThid )
                0112
aa03c27196 Jean*0113       _BEGIN_MASTER( myThid )
b15f6f1e9f Jean*0114       n2dWetPts  = loc2dNwet
                0115       n3dWetPts  = loc3dNwet
                0116       globalArea = loc2dArea
                0117       rAc_3dMean = 0. _d 0
                0118       IF ( loc3dNwet .GT. zeroRL ) rAc_3dMean = loc3dArea / loc3dNwet
aa03c27196 Jean*0119 C-    list empty tiles:
                0120       msgBuf(1:1) = ' '
                0121       DO bj = 1,nSy
                0122        DO bi = 1,nSx
                0123         IF ( tileArea(bi,bj).EQ.0. _d 0 ) THEN
                0124 #ifdef ALLOW_EXCH2
                0125          WRITE(msgBuf,'(A,I6,A,2I4,A)')
                0126      &    'Empty tile: #', W2_myTileList(bi,bj), ' (bi,bj=',bi,bj,' )'
                0127 #else
                0128          WRITE(msgBuf,'(A,I6,I6)') 'Empty tile bi,bj=', bi, bj
                0129 #endif
                0130          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0131      &                       SQUEEZE_RIGHT, myThid )
                0132         ENDIF
                0133        ENDDO
                0134       ENDDO
                0135       IF ( msgBuf(1:1).NE.' ' ) THEN
                0136          WRITE(msgBuf,'(A)') ' '
                0137          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0138      &                       SQUEEZE_RIGHT, myThid )
                0139       ENDIF
                0140       _END_MASTER( myThid )
                0141
                0142 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0143
                0144 C--   With Cubed-Sphere Exchanges, check if CS-corners are part of the domain
                0145       IF ( useCubedSphereExchange ) THEN
                0146         nCorners = 0
                0147         DO bj = myByLo(myThid), myByHi(myThid)
                0148          DO bi = myBxLo(myThid), myBxHi(myThid)
                0149 #ifdef ALLOW_EXCH2
                0150            myTile = W2_myTileList(bi,bj)
                0151            southWestCorner = exch2_isWedge(myTile).EQ.1
                0152      &                 .AND. exch2_isSedge(myTile).EQ.1
                0153            southEastCorner = exch2_isEedge(myTile).EQ.1
                0154      &                 .AND. exch2_isSedge(myTile).EQ.1
                0155            northEastCorner = exch2_isEedge(myTile).EQ.1
                0156      &                 .AND. exch2_isNedge(myTile).EQ.1
                0157            northWestCorner = exch2_isWedge(myTile).EQ.1
                0158      &                 .AND. exch2_isNedge(myTile).EQ.1
                0159 #else /* ALLOW_EXCH2 */
                0160            southWestCorner = .TRUE.
                0161            southEastCorner = .TRUE.
                0162            northWestCorner = .TRUE.
                0163            northEastCorner = .TRUE.
                0164 #endif /* ALLOW_EXCH2 */
                0165            IF ( southWestCorner .AND. kSurfC( 1 , 1 ,bi,bj).LE.Nr )
                0166      &       nCorners = nCorners + 1
                0167            IF ( southEastCorner .AND. kSurfC(sNx, 1 ,bi,bj).LE.Nr )
                0168      &       nCorners = nCorners + 1
                0169            IF ( northWestCorner .AND. kSurfC( 1 ,sNy,bi,bj).LE.Nr )
                0170      &       nCorners = nCorners + 1
                0171            IF ( northEastCorner .AND. kSurfC(sNx,sNy,bi,bj).LE.Nr )
                0172      &       nCorners = nCorners + 1
                0173          ENDDO
                0174         ENDDO
                0175         CALL GLOBAL_SUM_INT( nCorners, myThid )
                0176         _BEGIN_MASTER( myThid )
                0177         IF ( nCorners.GE.1 ) hasWetCSCorners = .TRUE.
                0178         WRITE(msgBuf,'(A,I4,A)') 'INI_GLOBAL_DOMAIN: Found',
                0179      &                 nCorners, ' CS-corner Pts in the domain'
                0180         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0181      &                      SQUEEZE_RIGHT, myThid )
                0182         _END_MASTER( myThid )
                0183       ENDIF
                0184
                0185 C--   Everyone else must wait for global-domain parameters to be set
                0186       _BARRIER
                0187
                0188 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0189       RETURN
                0190       END