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:
                0034 C     === Routine arguments ===
                0035 C     myThid :: my Thread Id number
                0036       INTEGER myThid
                0037
                0038 C     == Local variables in common ==
                0039       _RL tileArea(nSx,nSy), threadArea
                0040 C     put tileArea in (local) common block to print from master-thread:
                0041       COMMON / LOCAL_INI_GLOB_DOMAIN / tileArea
                0042
                0043 C     !LOCAL VARIABLES:
                0044 C     === Local variables ===
                0045 C     bi,bj  :: tile indices
                0046 C     i, j   :: Loop counters
                0047       INTEGER bi, bj
                0048       INTEGER i, j, nCorners
                0049       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0050       LOGICAL northWestCorner, northEastCorner,
                0051      &        southWestCorner, southEastCorner
                0052 #ifdef ALLOW_EXCH2
                0053       INTEGER myTile
                0054 #endif /* ALLOW_EXCH2 */
                0055 CEOP
                0056
                0057 C--   Initialisation
                0058
                0059 #ifdef NONLIN_FRSURF
                0060 C--   Save initial geometrical hFac factor into h0Fac (fixed in time):
                0061 C     better here (after packages_init_fixed call) than in INI_MASKS_ETC
                0062 C     in case 1 pkg would need to modify them.
                0063 C    <= moved to INI_MASK_ETC , despite comment above, since:
                0064 C      a) in case 1 pkg is changing hFac, this pkg should also update h0Fac
                0065 C      b) pkg/shelfice does modify hFac but done directly within ini_masks_etc
                0066 #endif /* NONLIN_FRSURF */
                0067
                0068 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0069
                0070 C--   Calculate global domain area:
                0071 C     use to be in ini_masks_etc.F but has been move after packages_init_fixed
                0072 C     in case 1 pkg (e.g., OBCS) modifies the domain size.
                0073       threadArea = 0. _d 0
                0074       DO bj = myByLo(myThid), myByHi(myThid)
                0075        DO bi = myBxLo(myThid), myBxHi(myThid)
                0076 C-      Compute the domain Area:
                0077         tileArea(bi,bj) = 0. _d 0
                0078         DO j=1,sNy
                0079          DO i=1,sNx
                0080           tileArea(bi,bj) = tileArea(bi,bj)
                0081      &                    + rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
                0082          ENDDO
                0083         ENDDO
                0084 c       threadArea = threadArea + tileArea(bi,bj)
                0085        ENDDO
                0086       ENDDO
                0087 c#ifdef ALLOW_AUTODIFF_TAMC
                0088 C_jmc: apply GLOBAL_SUM to thread-local variable (not in common block)
                0089 c      _GLOBAL_SUM_RL( threadArea, myThid )
                0090 c#else
                0091       CALL GLOBAL_SUM_TILE_RL( tileArea, threadArea, myThid )
                0092 c#endif
                0093       _BEGIN_MASTER( myThid )
                0094       globalArea = threadArea
                0095 C-    list empty tiles:
                0096       msgBuf(1:1) = ' '
                0097       DO bj = 1,nSy
                0098        DO bi = 1,nSx
                0099         IF ( tileArea(bi,bj).EQ.0. _d 0 ) THEN
                0100 #ifdef ALLOW_EXCH2
                0101          WRITE(msgBuf,'(A,I6,A,2I4,A)')
                0102      &    'Empty tile: #', W2_myTileList(bi,bj), ' (bi,bj=',bi,bj,' )'
                0103 #else
                0104          WRITE(msgBuf,'(A,I6,I6)') 'Empty tile bi,bj=', bi, bj
                0105 #endif
                0106          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0107      &                       SQUEEZE_RIGHT, myThid )
                0108         ENDIF
                0109        ENDDO
                0110       ENDDO
                0111       IF ( msgBuf(1:1).NE.' ' ) THEN
                0112          WRITE(msgBuf,'(A)') ' '
                0113          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0114      &                       SQUEEZE_RIGHT, myThid )
                0115       ENDIF
                0116       _END_MASTER( myThid )
                0117
                0118 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0119
                0120 C--   With Cubed-Sphere Exchanges, check if CS-corners are part of the domain
                0121       IF ( useCubedSphereExchange ) THEN
                0122         nCorners = 0
                0123         DO bj = myByLo(myThid), myByHi(myThid)
                0124          DO bi = myBxLo(myThid), myBxHi(myThid)
                0125 #ifdef ALLOW_EXCH2
                0126            myTile = W2_myTileList(bi,bj)
                0127            southWestCorner = exch2_isWedge(myTile).EQ.1
                0128      &                 .AND. exch2_isSedge(myTile).EQ.1
                0129            southEastCorner = exch2_isEedge(myTile).EQ.1
                0130      &                 .AND. exch2_isSedge(myTile).EQ.1
                0131            northEastCorner = exch2_isEedge(myTile).EQ.1
                0132      &                 .AND. exch2_isNedge(myTile).EQ.1
                0133            northWestCorner = exch2_isWedge(myTile).EQ.1
                0134      &                 .AND. exch2_isNedge(myTile).EQ.1
                0135 #else /* ALLOW_EXCH2 */
                0136            southWestCorner = .TRUE.
                0137            southEastCorner = .TRUE.
                0138            northWestCorner = .TRUE.
                0139            northEastCorner = .TRUE.
                0140 #endif /* ALLOW_EXCH2 */
                0141            IF ( southWestCorner .AND. kSurfC( 1 , 1 ,bi,bj).LE.Nr )
                0142      &       nCorners = nCorners + 1
                0143            IF ( southEastCorner .AND. kSurfC(sNx, 1 ,bi,bj).LE.Nr )
                0144      &       nCorners = nCorners + 1
                0145            IF ( northWestCorner .AND. kSurfC( 1 ,sNy,bi,bj).LE.Nr )
                0146      &       nCorners = nCorners + 1
                0147            IF ( northEastCorner .AND. kSurfC(sNx,sNy,bi,bj).LE.Nr )
                0148      &       nCorners = nCorners + 1
                0149          ENDDO
                0150         ENDDO
                0151         CALL GLOBAL_SUM_INT( nCorners, myThid )
                0152         _BEGIN_MASTER( myThid )
                0153         IF ( nCorners.GE.1 ) hasWetCSCorners = .TRUE.
                0154         WRITE(msgBuf,'(A,I4,A)') 'INI_GLOBAL_DOMAIN: Found',
                0155      &                 nCorners, ' CS-corner Pts in the domain'
                0156         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0157      &                      SQUEEZE_RIGHT, myThid )
                0158         _END_MASTER( myThid )
                0159       ENDIF
                0160
                0161 C--   Everyone else must wait for global-domain parameters to be set
                0162       _BARRIER
                0163
                0164 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0165       RETURN
                0166       END