1 |
C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_spherical_polar_grid.F,v 1.6 1998/06/22 15:26:25 adcroft Exp $ |
2 |
|
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 |
C myThid - Number of this instance of INI_CARTESIAN_GRID |
26 |
INTEGER myThid |
27 |
CEndOfInterface |
28 |
|
29 |
C == Local variables == |
30 |
C xG, yG - Global coordinate location. |
31 |
C zG |
32 |
C xBase - South-west corner location for process. |
33 |
C yBase |
34 |
C zUpper - Work arrays for upper and lower |
35 |
C zLower cell-face heights. |
36 |
C phi - Temporary scalar |
37 |
C iG, jG - Global coordinate index. Usually used to hold |
38 |
C the south-west global coordinate of a tile. |
39 |
C bi,bj - Loop counters |
40 |
C zUpper - Temporary arrays holding z coordinates of |
41 |
C zLower upper and lower faces. |
42 |
C xBase - Lower coordinate for this threads cells |
43 |
C yBase |
44 |
C lat, latN, - Temporary variables used to hold latitude |
45 |
C latS values. |
46 |
C I,J,K |
47 |
INTEGER bi, bj |
48 |
INTEGER I, J, K |
49 |
|
50 |
C Calculate quantities derived from XY depth map |
51 |
DO bj = myByLo(myThid), myByHi(myThid) |
52 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
53 |
DO J=1,sNy |
54 |
DO I=1,sNx |
55 |
C Inverse of depth |
56 |
IF ( h(i,j,bi,bj) .EQ. 0. _d 0 ) THEN |
57 |
rH(i,j,bi,bj) = 0. _d 0 |
58 |
ELSE |
59 |
rH(i,j,bi,bj) = 1. _d 0 / H(i,j,bi,bj) |
60 |
ENDIF |
61 |
ENDDO |
62 |
ENDDO |
63 |
ENDDO |
64 |
ENDDO |
65 |
_EXCH_XY_R4( rH, myThid ) |
66 |
|
67 |
C hFacW and hFacS (at U and V points) |
68 |
DO bj=myByLo(myThid), myByHi(myThid) |
69 |
DO bi=myBxLo(myThid), myBxHi(myThid) |
70 |
DO K=1, Nz |
71 |
DO J=1,sNy |
72 |
DO I=1,sNx |
73 |
hFacW(I,J,K,bi,bj)= |
74 |
& MIN(hFacC(I,J,K,bi,bj),hFacC(I-1,J,K,bi,bj)) |
75 |
hFacS(I,J,K,bi,bj)= |
76 |
& MIN(hFacC(I,J,K,bi,bj),hFacC(I,J-1,K,bi,bj)) |
77 |
ENDDO |
78 |
ENDDO |
79 |
ENDDO |
80 |
ENDDO |
81 |
ENDDO |
82 |
_EXCH_XYZ_R4(hFacW , myThid ) |
83 |
_EXCH_XYZ_R4(hFacS , myThid ) |
84 |
|
85 |
C Masks and reciprocals of hFac[CWS] |
86 |
DO bj = myByLo(myThid), myByHi(myThid) |
87 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
88 |
DO K=1,Nz |
89 |
DO J=1,sNy |
90 |
DO I=1,sNx |
91 |
IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN |
92 |
rHFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj) |
93 |
ELSE |
94 |
rHFacC(I,J,K,bi,bj) = 0. D0 |
95 |
ENDIF |
96 |
IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN |
97 |
rHFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj) |
98 |
maskW(I,J,K,bi,bj) = 1. D0 |
99 |
ELSE |
100 |
rHFacW(I,J,K,bi,bj) = 0. D0 |
101 |
maskW(I,J,K,bi,bj) = 0.0 D0 |
102 |
ENDIF |
103 |
IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN |
104 |
rHFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj) |
105 |
maskS(I,J,K,bi,bj) = 1. D0 |
106 |
ELSE |
107 |
rHFacS(I,J,K,bi,bj) = 0. D0 |
108 |
maskS(I,J,K,bi,bj) = 0. D0 |
109 |
ENDIF |
110 |
ENDDO |
111 |
ENDDO |
112 |
ENDDO |
113 |
ENDDO |
114 |
ENDDO |
115 |
_EXCH_XYZ_R4(rHFacC , myThid ) |
116 |
_EXCH_XYZ_R4(rHFacW , myThid ) |
117 |
_EXCH_XYZ_R4(rHFacS , myThid ) |
118 |
_EXCH_XYZ_R4(maskW , myThid ) |
119 |
_EXCH_XYZ_R4(maskS , myThid ) |
120 |
|
121 |
C Calculate recipricols grid lengths |
122 |
DO bj = myByLo(myThid), myByHi(myThid) |
123 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
124 |
DO J=1,sNy |
125 |
DO I=1,sNx |
126 |
rDxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj) |
127 |
rDyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj) |
128 |
rDxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj) |
129 |
rDyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj) |
130 |
rDxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj) |
131 |
rDyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj) |
132 |
rDxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj) |
133 |
rDyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj) |
134 |
ENDDO |
135 |
ENDDO |
136 |
ENDDO |
137 |
ENDDO |
138 |
_EXCH_XY_R4(rDxG, myThid ) |
139 |
_EXCH_XY_R4(rDyG, myThid ) |
140 |
_EXCH_XY_R4(rDxC, myThid ) |
141 |
_EXCH_XY_R4(rDyC, myThid ) |
142 |
_EXCH_XY_R4(rDxF, myThid ) |
143 |
_EXCH_XY_R4(rDyF, myThid ) |
144 |
_EXCH_XY_R4(rDxV, myThid ) |
145 |
_EXCH_XY_R4(rDyU, myThid ) |
146 |
|
147 |
C |
148 |
RETURN |
149 |
END |