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

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

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

Revision 1.8 - (hide annotations) (download)
Tue Sep 29 18:50:57 1998 UTC (25 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint15
Changes since 1.7: +5 -1 lines 
Changes for new exchange routines which do general tile <-> tile
connectivity, variable width overlap regions and provide
hooks for shared memory  and DMA protocols like Arctic, Memory Channel
etc..
1 cnh 1.8 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_masks_etc.F,v 1.7 1998/09/08 01:37:49 cnh Exp $
2 adcroft 1.1
3     #include "CPP_EEOPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE INI_MASKS_ETC( myThid )
7     C /==========================================================\
8     C | SUBROUTINE INI_MASKS_ETC |
9     C | o Initialise masks and topography factors |
10     C |==========================================================|
11     C | These arrays are used throughout the code and describe |
12     C | the topography of the domain through masks (0s and 1s) |
13     C | and fractional height factors (0<hFac<1). The latter |
14     C | distinguish between the lopped-cell and full-step |
15     C | topographic representations. |
16     C \==========================================================/
17    
18     C === Global variables ===
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "PARAMS.h"
22     #include "GRID.h"
23    
24     C == Routine arguments ==
25 cnh 1.6 C myThid - Number of this instance of INI_MASKS_ETC
26 adcroft 1.1 INTEGER myThid
27     CEndOfInterface
28    
29     C == Local variables ==
30     C bi,bj - Loop counters
31     C I,J,K
32     INTEGER bi, bj
33     INTEGER I, J, K
34    
35     C Calculate quantities derived from XY depth map
36     DO bj = myByLo(myThid), myByHi(myThid)
37     DO bi = myBxLo(myThid), myBxHi(myThid)
38     DO J=1,sNy
39     DO I=1,sNx
40     C Inverse of depth
41     IF ( h(i,j,bi,bj) .EQ. 0. _d 0 ) THEN
42 cnh 1.4 recip_H(i,j,bi,bj) = 0. _d 0
43 adcroft 1.1 ELSE
44 cnh 1.4 recip_H(i,j,bi,bj) = 1. _d 0 / abs( H(i,j,bi,bj) )
45 adcroft 1.1 ENDIF
46 cnh 1.7 depthInK(i,j,bi,bj) = 0.
47 adcroft 1.1 ENDDO
48     ENDDO
49     ENDDO
50     ENDDO
51 cnh 1.4 _EXCH_XY_R4( recip_H, myThid )
52 cnh 1.8 IF ( myThid .EQ. 1 ) WRITE(0,*) 'AAAA'
53 adcroft 1.2
54     C Calculate lopping factor hFacC
55     DO bj=myByLo(myThid), myByHi(myThid)
56     DO bi=myBxLo(myThid), myBxHi(myThid)
57 cnh 1.4 DO K=1, Nr
58 adcroft 1.2 DO J=1,sNy
59     DO I=1,sNx
60 cnh 1.7 C Round depths within a small fraction of layer depth to that
61     C layer depth.
62     IF ( ABS(H(I,J,bi,bj)-rF(K)) .LT. 1. _d -6*ABS(rF(K)) .AND.
63     & ABS(H(I,J,bi,bj)-rF(K)) .LT. 1. _d -6*ABS(H(I,J,bi,bj)) )THEN
64     H(I,J,bi,bj) = rF(K)
65     ENDIF
66 cnh 1.6 IF ( H(I,J,bi,bj)*rkFac .GE. rF(K)*rkFac ) THEN
67 adcroft 1.3 C Top of cell is below base of domain
68 adcroft 1.2 hFacC(I,J,K,bi,bj) = 0.
69 cnh 1.6 ELSEIF ( H(I,J,bi,bj)*rkFac .LE. rF(K+1)*rkFac ) THEN
70 adcroft 1.3 C Base of domain is below bottom of this cell
71 adcroft 1.2 hFacC(I,J,K,bi,bj) = 1.
72     ELSE
73     C Base of domain is in this cell
74 adcroft 1.3 C Set hFac to the fraction of the cell that is open.
75 cnh 1.7 C hFacC(I,J,K,bi,bj) = (rF(K)*rkFac-H(I,J,bi,bj)*rkFac)*recip_drF(K)
76     CcnhDebugStarts
77     C Impose full-step
78     hFacC(I,J,K,bi,bj) = 1.
79     CCnhDebugEnds
80 adcroft 1.3 ENDIF
81     C Impose minimum fraction
82     IF (hFacC(I,J,K,bi,bj).LT.hFacMin) THEN
83     IF (hFacC(I,J,K,bi,bj).LT.hFacMin*0.5) THEN
84     hFacC(I,J,K,bi,bj)=0.
85     ELSE
86     hFacC(I,J,K,bi,bj)=hFacMin
87     ENDIF
88     ENDIF
89     C Impose minimum size (dimensional)
90 cnh 1.5 IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr) THEN
91     IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr*0.5) THEN
92 adcroft 1.3 hFacC(I,J,K,bi,bj)=0.
93     ELSE
94 cnh 1.5 hFacC(I,J,K,bi,bj)=hFacMinDr*recip_drF(k)
95 adcroft 1.3 ENDIF
96 adcroft 1.2 ENDIF
97 cnh 1.7 depthInK(i,j,bi,bj) = depthInK(i,j,bi,bj) + hFacC(i,j,k,bi,bj)
98 adcroft 1.2 ENDDO
99     ENDDO
100     ENDDO
101     ENDDO
102     ENDDO
103 cnh 1.8 IF ( myThid .EQ. 1 ) WRITE(0,*) 'BBBB'
104 adcroft 1.2 _EXCH_XYZ_R4(hFacC , myThid )
105 cnh 1.8 IF ( myThid .EQ. 1 ) WRITE(0,*) 'CCCC'
106 cnh 1.7 _EXCH_XY_R4( depthInK, myThid )
107    
108 cnh 1.8 IF ( myThid .EQ. 1 ) WRITE(0,*) 'DDDD'
109 cnh 1.7 CALL PLOT_FIELD_XYRS( depthInK, 'Model Depths K Index' , 1, myThid )
110 adcroft 1.1
111     C hFacW and hFacS (at U and V points)
112     DO bj=myByLo(myThid), myByHi(myThid)
113     DO bi=myBxLo(myThid), myBxHi(myThid)
114 cnh 1.4 DO K=1, Nr
115 adcroft 1.1 DO J=1,sNy
116     DO I=1,sNx
117     hFacW(I,J,K,bi,bj)=
118     & MIN(hFacC(I,J,K,bi,bj),hFacC(I-1,J,K,bi,bj))
119     hFacS(I,J,K,bi,bj)=
120     & MIN(hFacC(I,J,K,bi,bj),hFacC(I,J-1,K,bi,bj))
121     ENDDO
122     ENDDO
123     ENDDO
124     ENDDO
125     ENDDO
126     _EXCH_XYZ_R4(hFacW , myThid )
127     _EXCH_XYZ_R4(hFacS , myThid )
128    
129     C Masks and reciprocals of hFac[CWS]
130     DO bj = myByLo(myThid), myByHi(myThid)
131     DO bi = myBxLo(myThid), myBxHi(myThid)
132 cnh 1.4 DO K=1,Nr
133 adcroft 1.1 DO J=1,sNy
134     DO I=1,sNx
135     IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN
136 cnh 1.4 recip_HFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj)
137 adcroft 1.1 ELSE
138 cnh 1.4 recip_HFacC(I,J,K,bi,bj) = 0. D0
139 adcroft 1.1 ENDIF
140     IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN
141 cnh 1.4 recip_HFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj)
142 adcroft 1.1 maskW(I,J,K,bi,bj) = 1. D0
143     ELSE
144 cnh 1.4 recip_HFacW(I,J,K,bi,bj) = 0. D0
145 adcroft 1.1 maskW(I,J,K,bi,bj) = 0.0 D0
146     ENDIF
147     IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN
148 cnh 1.4 recip_HFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj)
149 adcroft 1.1 maskS(I,J,K,bi,bj) = 1. D0
150     ELSE
151 cnh 1.4 recip_HFacS(I,J,K,bi,bj) = 0. D0
152 adcroft 1.1 maskS(I,J,K,bi,bj) = 0. D0
153     ENDIF
154     ENDDO
155     ENDDO
156     ENDDO
157     ENDDO
158     ENDDO
159 cnh 1.4 _EXCH_XYZ_R4(recip_HFacC , myThid )
160     _EXCH_XYZ_R4(recip_HFacW , myThid )
161     _EXCH_XYZ_R4(recip_HFacS , myThid )
162 adcroft 1.1 _EXCH_XYZ_R4(maskW , myThid )
163     _EXCH_XYZ_R4(maskS , myThid )
164    
165     C Calculate recipricols grid lengths
166     DO bj = myByLo(myThid), myByHi(myThid)
167     DO bi = myBxLo(myThid), myBxHi(myThid)
168     DO J=1,sNy
169     DO I=1,sNx
170 cnh 1.4 recip_dxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)
171     recip_dyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)
172     recip_dxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)
173     recip_dyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)
174     recip_dxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)
175     recip_dyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)
176     recip_dxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)
177     recip_dyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)
178 adcroft 1.1 ENDDO
179     ENDDO
180     ENDDO
181     ENDDO
182 cnh 1.4 _EXCH_XY_R4(recip_dxG, myThid )
183     _EXCH_XY_R4(recip_dyG, myThid )
184     _EXCH_XY_R4(recip_dxC, myThid )
185     _EXCH_XY_R4(recip_dyC, myThid )
186     _EXCH_XY_R4(recip_dxF, myThid )
187     _EXCH_XY_R4(recip_dyF, myThid )
188     _EXCH_XY_R4(recip_dxV, myThid )
189     _EXCH_XY_R4(recip_dyU, myThid )
190 adcroft 1.1
191     C
192     RETURN
193     END
  ViewVC Help
Powered by ViewVC 1.1.22