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

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

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

revision 1.2 by adcroft, Thu Jul 2 15:46:21 1998 UTC revision 1.9 by cnh, Wed Oct 28 03:11:37 1998 UTC
# Line 22  C     === Global variables === Line 22  C     === Global variables ===
22  #include "GRID.h"  #include "GRID.h"
23    
24  C     == Routine arguments ==  C     == Routine arguments ==
25  C     myThid -  Number of this instance of INI_CARTESIAN_GRID  C     myThid -  Number of this instance of INI_MASKS_ETC
26        INTEGER myThid        INTEGER myThid
27  CEndOfInterface  CEndOfInterface
28    
# Line 39  C     Calculate quantities derived from Line 39  C     Calculate quantities derived from
39           DO I=1,sNx           DO I=1,sNx
40  C         Inverse of depth  C         Inverse of depth
41            IF ( h(i,j,bi,bj) .EQ. 0. _d 0 ) THEN            IF ( h(i,j,bi,bj) .EQ. 0. _d 0 ) THEN
42             rH(i,j,bi,bj) = 0. _d 0             recip_H(i,j,bi,bj) = 0. _d 0
43            ELSE            ELSE
44             rH(i,j,bi,bj) = 1. _d 0 /  H(i,j,bi,bj)             recip_H(i,j,bi,bj) = 1. _d 0 /  abs( H(i,j,bi,bj) )
45            ENDIF            ENDIF
46              depthInK(i,j,bi,bj) = 0.
47           ENDDO           ENDDO
48          ENDDO          ENDDO
49         ENDDO         ENDDO
50        ENDDO        ENDDO
51        _EXCH_XY_R4(   rH, myThid )        _EXCH_XY_R4(   recip_H, myThid )
52          IF ( myThid .EQ. 1 ) WRITE(0,*) 'AAAA'
53    
54  C     Calculate lopping factor hFacC  C     Calculate lopping factor hFacC
55        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
56         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
57          DO K=1, Nz          DO K=1, Nr
58           DO J=1,sNy           DO J=1,sNy
59            DO I=1,sNx            DO I=1,sNx
60             IF     ( H(I,J,bi,bj) .LE. zFace(K) ) THEN  C          Round depths within a small fraction of layer depth to that
61  C           Below base of domain  C          layer depth.
62               IF ( ABS(H(I,J,bi,bj)-rF(K)) .LT.
63         &          1. _d -6*ABS(rF(K)) .AND.
64         &          ABS(H(I,J,bi,bj)-rF(K)) .LT.
65         &          1. _d -6*ABS(H(I,J,bi,bj)) )THEN
66                H(I,J,bi,bj) = rF(K)
67               ENDIF
68               IF     ( H(I,J,bi,bj)*rkFac .GE. rF(K)*rkFac ) THEN
69    C           Top of cell is below base of domain
70              hFacC(I,J,K,bi,bj) = 0.              hFacC(I,J,K,bi,bj) = 0.
71             ELSEIF ( H(I,J,bi,bj) .GT. zFace(K+1) ) THEN             ELSEIF ( H(I,J,bi,bj)*rkFac .LE. rF(K+1)*rkFac ) THEN
72  C           Base of domain is below this cell  C           Base of domain is below bottom of this cell
73              hFacC(I,J,K,bi,bj) = 1.              hFacC(I,J,K,bi,bj) = 1.
74             ELSE             ELSE
75  C           Base of domain is in this cell  C           Base of domain is in this cell
76  C           Set hFac tp the fraction of the cell that is open.  C           Set hFac to the fraction of the cell that is open.
77              hFacC(I,J,K,bi,bj) =  C           hFacC(I,J,K,bi,bj) = (rF(K)*rkFac-H(I,J,bi,bj)*rkFac)*recip_drF(K)
78       &        (zFace(K)-H(I,J,bi,bj))/(zFace(K)-zFace(K+1))  CcnhDebugStarts
79    C Impose full-step
80                hFacC(I,J,K,bi,bj) = 1.
81    CCnhDebugEnds
82               ENDIF
83    C Impose minimum fraction
84               IF (hFacC(I,J,K,bi,bj).LT.hFacMin) THEN
85                IF (hFacC(I,J,K,bi,bj).LT.hFacMin*0.5) THEN
86                 hFacC(I,J,K,bi,bj)=0.
87                ELSE
88                 hFacC(I,J,K,bi,bj)=hFacMin
89                ENDIF
90             ENDIF             ENDIF
91    C Impose minimum size (dimensional)
92               IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr) THEN
93                IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDr*0.5) THEN
94                 hFacC(I,J,K,bi,bj)=0.
95                ELSE
96                 hFacC(I,J,K,bi,bj)=hFacMinDr*recip_drF(k)
97                ENDIF
98               ENDIF
99               depthInK(i,j,bi,bj) = depthInK(i,j,bi,bj)
100         &                          +hFacC(i,j,k,bi,bj)
101            ENDDO            ENDDO
102           ENDDO           ENDDO
103          ENDDO          ENDDO
104         ENDDO         ENDDO
105        ENDDO        ENDDO
106          IF ( myThid .EQ. 1 ) WRITE(0,*) 'BBBB'
107        _EXCH_XYZ_R4(hFacC , myThid )        _EXCH_XYZ_R4(hFacC , myThid )
108          IF ( myThid .EQ. 1 ) WRITE(0,*) 'CCCC'
109          _EXCH_XY_R4( depthInK, myThid )
110    
111          IF ( myThid .EQ. 1 ) WRITE(0,*) 'DDDD'
112          CALL PLOT_FIELD_XYRS( depthInK,
113         & 'Model Depths K Index' , 1, myThid )
114    
115  C     hFacW and hFacS (at U and V points)  C     hFacW and hFacS (at U and V points)
116        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
117         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
118          DO K=1, Nz          DO K=1, Nr
119           DO J=1,sNy           DO J=1,sNy
120            DO I=1,sNx            DO I=1,sNx
121             hFacW(I,J,K,bi,bj)=             hFacW(I,J,K,bi,bj)=
# Line 95  C     hFacW and hFacS (at U and V points Line 133  C     hFacW and hFacS (at U and V points
133  C     Masks and reciprocals of hFac[CWS]  C     Masks and reciprocals of hFac[CWS]
134        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
135         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
136          DO K=1,Nz          DO K=1,Nr
137           DO J=1,sNy           DO J=1,sNy
138            DO I=1,sNx            DO I=1,sNx
139             IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN
140              rHFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj)              recip_HFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj)
141             ELSE             ELSE
142              rHFacC(I,J,K,bi,bj) = 0. D0              recip_HFacC(I,J,K,bi,bj) = 0. D0
143             ENDIF             ENDIF
144             IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN
145              rHFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj)              recip_HFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj)
146              maskW(I,J,K,bi,bj) = 1. D0              maskW(I,J,K,bi,bj) = 1. D0
147             ELSE             ELSE
148              rHFacW(I,J,K,bi,bj) = 0. D0              recip_HFacW(I,J,K,bi,bj) = 0. D0
149              maskW(I,J,K,bi,bj) = 0.0 D0              maskW(I,J,K,bi,bj) = 0.0 D0
150             ENDIF             ENDIF
151             IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN
152              rHFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj)              recip_HFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj)
153              maskS(I,J,K,bi,bj) = 1. D0              maskS(I,J,K,bi,bj) = 1. D0
154             ELSE             ELSE
155              rHFacS(I,J,K,bi,bj) = 0. D0              recip_HFacS(I,J,K,bi,bj) = 0. D0
156              maskS(I,J,K,bi,bj) = 0. D0              maskS(I,J,K,bi,bj) = 0. D0
157             ENDIF             ENDIF
158            ENDDO            ENDDO
# Line 122  C     Masks and reciprocals of hFac[CWS] Line 160  C     Masks and reciprocals of hFac[CWS]
160          ENDDO          ENDDO
161         ENDDO         ENDDO
162        ENDDO        ENDDO
163        _EXCH_XYZ_R4(rHFacC    , myThid )        _EXCH_XYZ_R4(recip_HFacC    , myThid )
164        _EXCH_XYZ_R4(rHFacW    , myThid )        _EXCH_XYZ_R4(recip_HFacW    , myThid )
165        _EXCH_XYZ_R4(rHFacS    , myThid )        _EXCH_XYZ_R4(recip_HFacS    , myThid )
166        _EXCH_XYZ_R4(maskW    , myThid )        _EXCH_XYZ_R4(maskW    , myThid )
167        _EXCH_XYZ_R4(maskS    , myThid )        _EXCH_XYZ_R4(maskS    , myThid )
168    
# Line 133  C     Calculate recipricols grid lengths Line 171  C     Calculate recipricols grid lengths
171         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
172          DO J=1,sNy          DO J=1,sNy
173           DO I=1,sNx           DO I=1,sNx
174            rDxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)            recip_dxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)
175            rDyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)            recip_dyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)
176            rDxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)            recip_dxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)
177            rDyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)            recip_dyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)
178            rDxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)            recip_dxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)
179            rDyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)            recip_dyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)
180            rDxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)            recip_dxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)
181            rDyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)            recip_dyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)
182           ENDDO           ENDDO
183          ENDDO          ENDDO
184         ENDDO         ENDDO
185        ENDDO        ENDDO
186        _EXCH_XY_R4(rDxG, myThid )        _EXCH_XY_R4(recip_dxG, myThid )
187        _EXCH_XY_R4(rDyG, myThid )        _EXCH_XY_R4(recip_dyG, myThid )
188        _EXCH_XY_R4(rDxC, myThid )        _EXCH_XY_R4(recip_dxC, myThid )
189        _EXCH_XY_R4(rDyC, myThid )        _EXCH_XY_R4(recip_dyC, myThid )
190        _EXCH_XY_R4(rDxF, myThid )        _EXCH_XY_R4(recip_dxF, myThid )
191        _EXCH_XY_R4(rDyF, myThid )        _EXCH_XY_R4(recip_dyF, myThid )
192        _EXCH_XY_R4(rDxV, myThid )        _EXCH_XY_R4(recip_dxV, myThid )
193        _EXCH_XY_R4(rDyU, myThid )        _EXCH_XY_R4(recip_dyU, myThid )
194    
195  C  C
196        RETURN        RETURN
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22