/[MITgcm]/MITgcm/model/src/ini_global_domain.F
ViewVC logotype

Annotation of /MITgcm/model/src/ini_global_domain.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.1 - (hide annotations) (download)
Fri Jul 13 22:07:09 2012 UTC (11 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64a, checkpoint63r, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint64b, checkpoint64e, checkpoint63q, checkpoint64d, checkpoint64c, checkpoint64g, checkpoint64f, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64i, checkpoint64h, checkpoint63s, checkpoint64k, checkpoint64, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l, HEAD 
to refine CS-grid check, add logical flag: true if using Cubed-Sphere Exch with
 CS-corners inside the domain; create new S/R INI_GLOBAL_DOMAIN from code in
 ini_linear_phisurf.F to calculate globalArea and to set this new logical flag.
1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/model/src/ini_linear_phisurf.F,v 1.20 2012/06/17 02:22:20 jmc Exp $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     CBOP
8     C !ROUTINE: INI_GLOBAL_DOMAIN
9     C !INTERFACE:
10     SUBROUTINE INI_GLOBAL_DOMAIN( myThid )
11    
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | SUBROUTINE INI_GLOBAL_DOMAIN
15     C | o Initialise domain (i.e., where there is fluid)
16     C | related (global) quantities.
17     C | Called after grid and masks are set (ini_grid,
18     C | ini_masks) or modified (packages_init_fixed call).
19     C *==========================================================*
20     C | Compute global domain Area ;
21     C *==========================================================*
22     C \ev
23    
24     C !USES:
25     IMPLICIT NONE
26     C === Global variables ===
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29     #include "PARAMS.h"
30     #include "GRID.h"
31     #ifdef ALLOW_EXCH2
32     # include "W2_EXCH2_SIZE.h"
33     # include "W2_EXCH2_TOPOLOGY.h"
34     #endif /* ALLOW_EXCH2 */
35    
36     C !INPUT/OUTPUT PARAMETERS:
37     C === Routine arguments ===
38     C myThid :: my Thread Id number
39     INTEGER myThid
40    
41     C == Local variables in common ==
42     _RL tileArea(nSx,nSy), threadArea
43     C put tileArea in (local) common block to print from master-thread:
44     COMMON / LOCAL_INI_GLOB_DOMAIN / tileArea
45    
46     C !LOCAL VARIABLES:
47     C === Local variables ===
48     C bi,bj :: tile indices
49     C i, j :: Loop counters
50     INTEGER bi, bj
51     INTEGER i, j, nCorners
52     CHARACTER*(MAX_LEN_MBUF) msgBuf
53     LOGICAL northWestCorner, northEastCorner,
54     & southWestCorner, southEastCorner
55     #ifdef ALLOW_EXCH2
56     INTEGER myTile
57     #endif /* ALLOW_EXCH2 */
58     CEOP
59    
60     C-- Initialisation
61    
62     #ifdef NONLIN_FRSURF
63     C-- Save initial geometrical hFac factor into h0Fac (fixed in time):
64     C better here (after packages_init_fixed call) than in INI_MASKS_ETC
65     C in case 1 pkg would need to modify them.
66     C <= moved to INI_MASK_ETC , despite comment above, since:
67     C a) in case 1 pkg is changing hFac, this pkg should also update h0Fac
68     C b) pkg/shelfice does modify hFac but done directly within ini_masks_etc
69     #endif /* NONLIN_FRSURF */
70    
71     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
72    
73     C-- Calculate global domain area:
74     C use to be in ini_masks_etc.F but has been move after packages_init_fixed
75     C in case 1 pkg (e.g., OBCS) modifies the domain size.
76     threadArea = 0. _d 0
77     DO bj = myByLo(myThid), myByHi(myThid)
78     DO bi = myBxLo(myThid), myBxHi(myThid)
79     C- Compute the domain Area:
80     tileArea(bi,bj) = 0. _d 0
81     DO j=1,sNy
82     DO i=1,sNx
83     tileArea(bi,bj) = tileArea(bi,bj)
84     & + rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
85     ENDDO
86     ENDDO
87     c threadArea = threadArea + tileArea(bi,bj)
88     ENDDO
89     ENDDO
90     c#ifdef ALLOW_AUTODIFF_TAMC
91     C_jmc: apply GLOBAL_SUM to thread-local variable (not in common block)
92     c _GLOBAL_SUM_RL( threadArea, myThid )
93     c#else
94     CALL GLOBAL_SUM_TILE_RL( tileArea, threadArea, myThid )
95     c#endif
96     _BEGIN_MASTER( myThid )
97     globalArea = threadArea
98     C- list empty tiles:
99     msgBuf(1:1) = ' '
100     DO bj = 1,nSy
101     DO bi = 1,nSx
102     IF ( tileArea(bi,bj).EQ.0. _d 0 ) THEN
103     #ifdef ALLOW_EXCH2
104     WRITE(msgBuf,'(A,I6,A,2I4,A)')
105     & 'Empty tile: #', W2_myTileList(bi,bj), ' (bi,bj=',bi,bj,' )'
106     #else
107     WRITE(msgBuf,'(A,I6,I6)') 'Empty tile bi,bj=', bi, bj
108     #endif
109     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
110     & SQUEEZE_RIGHT, myThid )
111     ENDIF
112     ENDDO
113     ENDDO
114     IF ( msgBuf(1:1).NE.' ' ) THEN
115     WRITE(msgBuf,'(A)') ' '
116     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
117     & SQUEEZE_RIGHT, myThid )
118     ENDIF
119     _END_MASTER( myThid )
120    
121     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
122    
123     C-- With Cubed-Sphere Exchanges, check if CS-corners are part of the domain
124     IF ( useCubedSphereExchange ) THEN
125     nCorners = 0
126     DO bj = myByLo(myThid), myByHi(myThid)
127     DO bi = myBxLo(myThid), myBxHi(myThid)
128     #ifdef ALLOW_EXCH2
129     myTile = W2_myTileList(bi,bj)
130     southWestCorner = exch2_isWedge(myTile).EQ.1
131     & .AND. exch2_isSedge(myTile).EQ.1
132     southEastCorner = exch2_isEedge(myTile).EQ.1
133     & .AND. exch2_isSedge(myTile).EQ.1
134     northEastCorner = exch2_isEedge(myTile).EQ.1
135     & .AND. exch2_isNedge(myTile).EQ.1
136     northWestCorner = exch2_isWedge(myTile).EQ.1
137     & .AND. exch2_isNedge(myTile).EQ.1
138     #else /* ALLOW_EXCH2 */
139     southWestCorner = .TRUE.
140     southEastCorner = .TRUE.
141     northWestCorner = .TRUE.
142     northEastCorner = .TRUE.
143     #endif /* ALLOW_EXCH2 */
144     IF ( southWestCorner .AND. kSurfC( 1 , 1 ,bi,bj).LE.Nr )
145     & nCorners = nCorners + 1
146     IF ( southEastCorner .AND. kSurfC(sNx, 1 ,bi,bj).LE.Nr )
147     & nCorners = nCorners + 1
148     IF ( northWestCorner .AND. kSurfC( 1 ,sNy,bi,bj).LE.Nr )
149     & nCorners = nCorners + 1
150     IF ( northEastCorner .AND. kSurfC(sNx,sNy,bi,bj).LE.Nr )
151     & nCorners = nCorners + 1
152     ENDDO
153     ENDDO
154     CALL GLOBAL_SUM_INT( nCorners, myThid )
155     _BEGIN_MASTER( myThid )
156     IF ( nCorners.GE.1 ) hasWetCSCorners = .TRUE.
157     WRITE(msgBuf,'(A,I4,A)') 'INI_GLOBAL_DOMAIN: Found',
158     & nCorners, ' CS-corner Pts in the domain'
159     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
160     & SQUEEZE_RIGHT, myThid )
161     _END_MASTER( myThid )
162     ENDIF
163    
164     C-- Everyone else must wait for global-domain parameters to be set
165     _BARRIER
166    
167     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
168     RETURN
169     END
  ViewVC Help
Powered by ViewVC 1.1.22