1 |
C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_depths.F,v 1.7 1998/06/15 05:13:56 cnh Exp $ |
2 |
|
3 |
#include "CPP_EEOPTIONS.h" |
4 |
|
5 |
CStartOfInterface |
6 |
SUBROUTINE INI_DEPTHS( myThid ) |
7 |
C /==========================================================\ |
8 |
C | SUBROUTINE INI_DEPTHS | |
9 |
C | o Initialise map of model depths | |
10 |
C |==========================================================| |
11 |
C | The depths of the bottom of the model is specified in | |
12 |
C | terms of an XY map with one depth for each column of | |
13 |
C | grid cells. Depths do not have to coincide with the | |
14 |
C | model levels. The model's lopping algorithm makes it | |
15 |
C | possible to represent arbitrary depths. | |
16 |
C | The mode depths map also influences the models topology | |
17 |
C | By default the model domain wraps around in X and Y. | |
18 |
C | This default doubly periodic topology is "supressed" | |
19 |
C | if a depth map is defined which closes off all wrap | |
20 |
C | around flow. | |
21 |
C \==========================================================/ |
22 |
|
23 |
C === Global variables === |
24 |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
26 |
#include "PARAMS.h" |
27 |
#include "GRID.h" |
28 |
|
29 |
C == Routine arguments == |
30 |
C myThid - Number of this instance of INI_DEPTHS |
31 |
INTEGER myThid |
32 |
CEndOfInterface |
33 |
|
34 |
C == Local variables == |
35 |
C xG, yG - Global coordinate location. |
36 |
C zG |
37 |
C zUpper - Work arrays for upper and lower |
38 |
C zLower cell-face heights. |
39 |
C phi - Temporary scalar |
40 |
C iG, jG - Global coordinate index |
41 |
C bi,bj - Loop counters |
42 |
C zUpper - Temporary arrays holding z coordinates of |
43 |
C zLower upper and lower faces. |
44 |
C I,J,K |
45 |
_RL xG, yG, zG |
46 |
_RL phi |
47 |
_RL zUpper(Nz), zLower(Nz) |
48 |
INTEGER iG, jG |
49 |
INTEGER bi, bj |
50 |
INTEGER I, J, K |
51 |
|
52 |
_BARRIER |
53 |
IF ( bathyFile .EQ. ' ' ) THEN |
54 |
C Set up a flat bottom box with doubly periodic topology. |
55 |
C H is the basic variable from which other terms are derived. It |
56 |
C is the term that would be set from an external file for a |
57 |
C realistic problem. |
58 |
phi = 0. D0 |
59 |
DO K=1,Nz |
60 |
phi = phi+delZ(K) |
61 |
ENDDO |
62 |
DO bj = myByLo(myThid), myByHi(myThid) |
63 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
64 |
DO j=1,sNy |
65 |
DO i=1,sNx |
66 |
iG = myXGlobalLo-1+(bi-1)*sNx+I |
67 |
jG = myYGlobalLo-1+(bj-1)*sNy+J |
68 |
C Default depth of full domain |
69 |
H(i,j,bi,bj) = phi |
70 |
C Test for eastern edge |
71 |
IF ( iG .EQ. nX ) H(i,j,bi,bj) = 0. |
72 |
C Test for northern edge |
73 |
IF ( jG .EQ. nY ) H(i,j,bi,bj) = 0. |
74 |
C Island |
75 |
IF ( iG .EQ. 1 .AND. |
76 |
& jG .EQ. 24 ) H(i,j,bi,bj) = 0.75*phi |
77 |
ENDDO |
78 |
ENDDO |
79 |
ENDDO |
80 |
ENDDO |
81 |
ELSE |
82 |
_BEGIN_MASTER( myThid ) |
83 |
CALL READ_FLD_XY_RS( bathyFile, ' ', H, 0, myThid ) |
84 |
_END_MASTER(myThid) |
85 |
ENDIF |
86 |
_EXCH_XY_R4( H, myThid ) |
87 |
|
88 |
C-- Now calculate "lopping" factors hFac. |
89 |
zG = delZ(1)*0.5 D0 |
90 |
zFace(1) = 0 |
91 |
dzC(1) = delz(1)/2. _d 0 |
92 |
rDzC(1) = 2. _d 0/delZ(1) |
93 |
DO K=1,Nz-1 |
94 |
saFac(K) = 1. D0 |
95 |
zC(K) = zG |
96 |
zG = zG + (delZ(K)+delZ(K+1))*0.5 D0 |
97 |
zFace(K+1) = zFace(K)+delZ(K) |
98 |
rDzC(K+1) = 2. _d 0/(delZ(K)+delZ(K+1)) |
99 |
dzC(K+1) = (delZ(K)+delZ(K+1))/2. _d 0 |
100 |
ENDDO |
101 |
zC(Nz) = zG |
102 |
zFace(Nz+1) = zFace(Nz)+delZ(Nz) |
103 |
DO K=1,Nz |
104 |
zUpper(K) = zFace(K) |
105 |
zLower(K) = zFace(K+1) |
106 |
dzF(K) = delz(K) |
107 |
rdzF(K) = 1.d0/dzF(K) |
108 |
ENDDO |
109 |
DO bj=myByLo(myThid), myByHi(myThid) |
110 |
DO bi=myBxLo(myThid), myBxHi(myThid) |
111 |
DO K=1, Nz |
112 |
DO J=1,sNy |
113 |
DO I=1,sNx |
114 |
hFacC(I,J,K,bi,bj) = 1. |
115 |
IF ( H(I,J,bi,bj) .LE. zUpper(K) ) THEN |
116 |
C Below base of domain |
117 |
hFacC(I,J,K,bi,bj) = 0. |
118 |
ELSEIF ( H(I,J,bi,bj) .GT. zLower(K) ) THEN |
119 |
C Base of domain is below this cell |
120 |
hFacC(I,J,K,bi,bj) = 1. |
121 |
ELSE |
122 |
C Base of domain is in this cell |
123 |
C Set hFac tp the fraction of the cell that is open. |
124 |
phi = zUpper(K)-H(I,J,bi,bj) |
125 |
hFacC(I,J,K,bi,bj) = phi/(zUpper(K)-zLower(K)) |
126 |
ENDIF |
127 |
ENDDO |
128 |
ENDDO |
129 |
ENDDO |
130 |
ENDDO |
131 |
ENDDO |
132 |
_EXCH_XYZ_R4(hFacC , myThid ) |
133 |
|
134 |
C |
135 |
CALL PLOT_FIELD_XYRS( H, 'Model depths' , 1, myThid ) |
136 |
C |
137 |
RETURN |
138 |
END |