/[MITgcm]/MITgcm/pkg/exch2/w2_e2setup.F
ViewVC logotype

Annotation of /MITgcm/pkg/exch2/w2_e2setup.F

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

Revision 1.7 - (hide annotations) (download)
Sat Jul 9 21:53:35 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, 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, HEAD
Changes since 1.6: +9 -6 lines 
rename + move: nTiles in W2_EXCH2_PARAMS.h --> exch2_nTiles in W2_EXCH2_TOPOLOGY.h
1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_e2setup.F,v 1.6 2010/04/23 20:21:06 jmc Exp $
2 jmc 1.2 C $Name: $
3    
4 jmc 1.4 #include "PACKAGES_CONFIG.h"
5     #include "CPP_EEOPTIONS.h"
6     #include "W2_OPTIONS.h"
7    
8     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9     CBOP 0
10     C !ROUTINE: W2_E2SETUP
11 jmc 1.2
12 jmc 1.4 C !INTERFACE:
13     SUBROUTINE W2_E2SETUP( myThid )
14 jmc 1.2
15 jmc 1.4 C !DESCRIPTION:
16     C Set-up W2_EXCH2 tile topology structures
17 jmc 1.3
18 jmc 1.4 C !USES:
19     IMPLICIT NONE
20 jmc 1.2
21 jmc 1.6 C Tile topology settings data structures
22 jmc 1.4 #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #ifdef ALLOW_EXCH2
25     #include "W2_EXCH2_SIZE.h"
26     #include "W2_EXCH2_TOPOLOGY.h"
27     #include "W2_EXCH2_PARAMS.h"
28     #endif
29    
30     C !INPUT PARAMETERS:
31     C myThid :: my Thread Id number
32     C (Note: not relevant since threading has not yet started)
33     INTEGER myThid
34    
35     #ifdef ALLOW_EXCH2
36    
37     C !LOCAL VARIABLES:
38     C === Local variables ===
39 jmc 1.6 C msgBuf :: Informational/error message buffer
40 jmc 1.4 C stdUnit :: Standard-Output IO unit number
41     CHARACTER*(MAX_LEN_MBUF) msgBuf
42 jmc 1.5 INTEGER stdUnit
43 jmc 1.4 INTEGER i, j, k
44     LOGICAL addBlank
45     CEOP
46    
47     stdUnit = standardMessageUnit
48    
49     C-- Initialise parameters from EXCH2_PARAMS common blocks
50     C (except params from namelist which are set in W2_READPARMS)
51     DO j=1,W2_maxNbFacets
52     facet_owns(1,j) = 0
53     facet_owns(2,j) = 0
54     DO i=1,4
55     DO k=1,4
56     facet_pij(k,i,j) = 0
57     ENDDO
58     facet_oi(i,j) = 0
59     facet_oj(i,j) = 0
60     ENDDO
61     ENDDO
62    
63     C-- Count Nb of Blank-Tiles and set Number of tiles:
64     nBlankTiles = 0
65     DO i=1,W2_maxNbTiles
66     IF (blankList(i).NE.0 ) THEN
67     addBlank = .TRUE.
68     DO j=1,nBlankTiles
69     IF ( blankList(i).EQ.blankList(j) ) THEN
70     addBlank = .FALSE.
71     WRITE(msgBuf,'(A,I5,A,2I3,A)')
72     & '** WARNING ** W2_E2SETUP: #', blankList(i),
73     & ' appears several times in blankList (',j,i,')'
74     CALL PRINT_MESSAGE( msgBuf, W2_oUnit,SQUEEZE_RIGHT,myThid )
75     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
76     & SQUEEZE_RIGHT, myThid )
77     ENDIF
78     ENDDO
79     IF ( addBlank ) THEN
80     nBlankTiles = nBlankTiles + 1
81     blankList(nBlankTiles) = blankList(i)
82     ENDIF
83     ENDIF
84     ENDDO
85 jmc 1.7 exch2_nTiles = nBlankTiles + (nSx*nSy*nPx*nPy)
86 jmc 1.4
87     WRITE(msgBuf,'(A,I8)')
88     & 'W2_E2SETUP: number of Active Tiles =', nSx*nSy*nPx*nPy
89     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
90     WRITE(msgBuf,'(A,I8)')
91     & 'W2_E2SETUP: number of Blank Tiles =', nBlankTiles
92     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
93     WRITE(msgBuf,'(A,I8)')
94 jmc 1.7 & 'W2_E2SETUP: Total number of Tiles =', exch2_nTiles
95 jmc 1.4 CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
96    
97 jmc 1.7 IF ( exch2_nTiles.GT.W2_maxNbTiles ) THEN
98 jmc 1.4 WRITE(msgBuf,'(3(A,I7))') 'W2_E2SETUP: Number of Tiles=',
99 jmc 1.7 & exch2_nTiles, ' >', W2_maxNbTiles, ' =W2_maxNbTiles'
100 jmc 1.4 CALL PRINT_ERROR( msgBuf, myThid )
101     WRITE(msgBuf,'(2A)') 'Must increase "W2_maxNbTiles"',
102     & ' in "W2_EXCH2_SIZE.h" + recompile'
103     CALL PRINT_ERROR( msgBuf, myThid )
104     STOP 'ABNORMAL END: S/R W2_E2SETUP (nTiles>maxNbTiles)'
105     ENDIF
106    
107     C-- Check blankList:
108     DO i=1,nBlankTiles
109 jmc 1.7 IF ( blankList(i).LT.1 .OR. blankList(i).GT.exch2_nTiles ) THEN
110 jmc 1.4 WRITE(msgBuf,'(A,I5,A,I8)')
111     & 'W2_E2SETUP: Invalid blankTile number (i=', i,
112     & ' )=', blankList(i)
113     WRITE(msgBuf,'(A,I7,A,I4,A)') 'W2_E2SETUP:', blankList(i),
114     & ' = Invalid blankTile number (i=', i, ')'
115     CALL PRINT_ERROR( msgBuf, myThid )
116     STOP 'ABNORMAL END: S/R W2_E2SETUP (blankList error)'
117     ENDIF
118     ENDDO
119    
120     C-- Define Facet (sub-domain) Topology: Size and Connections
121     IF ( preDefTopol.EQ.0 ) THEN
122     CALL W2_SET_GEN_FACETS( myThid )
123     ELSEIF ( preDefTopol.EQ.1 ) THEN
124     CALL W2_SET_SINGLE_FACET( myThid )
125     ELSEIF ( preDefTopol.EQ.2 ) THEN
126     CALL W2_SET_MYOWN_FACETS( myThid )
127     ELSEIF ( preDefTopol.EQ.3 ) THEN
128     CALL W2_SET_CS6_FACETS( myThid )
129     ELSE
130     STOP 'ABNORMAL END: S/R W2_E2SETUP (invalid preDefTopol)'
131     ENDIF
132    
133     WRITE(msgBuf,'(A,I8)')
134     & 'W2_E2SETUP: Total number of Facets =', nFacets
135     CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
136    
137     C-- Check Topology; setup correspondence matrix for connected Facet-Edges
138     CALL W2_SET_F2F_INDEX( myThid )
139    
140     C-- Define Tile Mapping (+ IO global mapping)
141     CALL W2_SET_MAP_TILES( myThid )
142 jmc 1.2
143 jmc 1.7 C-- Define Tile Mapping (for Cumulated Sum)
144     CALL W2_SET_MAP_CUMSUM( myThid )
145    
146 jmc 1.4 C-- Set-up tile neighbours and index relations for EXCH2
147     CALL W2_SET_TILE2TILES( myThid )
148 jmc 1.2
149 jmc 1.4 #endif /* ALLOW_EXCH2 */
150 jmc 1.2
151 jmc 1.4 RETURN
152     END
  ViewVC Help
Powered by ViewVC 1.1.22