/[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.3 by adcroft, Wed Jul 29 18:33:47 1998 UTC revision 1.4 by cnh, Sat Aug 22 17:51:08 1998 UTC
# 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 /  abs( H(i,j,bi,bj) )             recip_H(i,j,bi,bj) = 1. _d 0 /  abs( H(i,j,bi,bj) )
45            ENDIF            ENDIF
46           ENDDO           ENDDO
47          ENDDO          ENDDO
48         ENDDO         ENDDO
49        ENDDO        ENDDO
50        _EXCH_XY_R4(   rH, myThid )        _EXCH_XY_R4(   recip_H, myThid )
51    
52  C     Calculate lopping factor hFacC  C     Calculate lopping factor hFacC
53        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
54         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
55          DO K=1, Nz          DO K=1, Nr
56           DO J=1,sNy           DO J=1,sNy
57            DO I=1,sNx            DO I=1,sNx
58             IF     ( H(I,J,bi,bj) .GE. zFace(K) ) THEN             IF     ( H(I,J,bi,bj) .GE. rF(K) ) THEN
59  C           Top of cell is below base of domain  C           Top of cell is below base of domain
60              hFacC(I,J,K,bi,bj) = 0.              hFacC(I,J,K,bi,bj) = 0.
61             ELSEIF ( H(I,J,bi,bj) .LE. zFace(K+1) ) THEN             ELSEIF ( H(I,J,bi,bj) .LE. rF(K+1) ) THEN
62  C           Base of domain is below bottom of this cell  C           Base of domain is below bottom of this cell
63              hFacC(I,J,K,bi,bj) = 1.              hFacC(I,J,K,bi,bj) = 1.
64             ELSE             ELSE
65  C           Base of domain is in this cell  C           Base of domain is in this cell
66  C           Set hFac to the fraction of the cell that is open.  C           Set hFac to the fraction of the cell that is open.
67              hFacC(I,J,K,bi,bj) = (zFace(K)-H(I,J,bi,bj))*rdzF(K)              hFacC(I,J,K,bi,bj) = (rF(K)-H(I,J,bi,bj))*recip_drF(K)
68             ENDIF             ENDIF
69  C Impose minimum fraction  C Impose minimum fraction
70             IF (hFacC(I,J,K,bi,bj).LT.hFacMin) THEN             IF (hFacC(I,J,K,bi,bj).LT.hFacMin) THEN
# Line 75  C Impose minimum fraction Line 75  C Impose minimum fraction
75              ENDIF              ENDIF
76             ENDIF             ENDIF
77  C Impose minimum size (dimensional)  C Impose minimum size (dimensional)
78             IF (dzF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDz) THEN             IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDz) THEN
79              IF (dzF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDz*0.5) THEN              IF (drF(k)*hFacC(I,J,K,bi,bj).LT.hFacMinDz*0.5) THEN
80               hFacC(I,J,K,bi,bj)=0.               hFacC(I,J,K,bi,bj)=0.
81              ELSE              ELSE
82               hFacC(I,J,K,bi,bj)=hFacMinDz*rDzF(k)               hFacC(I,J,K,bi,bj)=hFacMinDz*recip_drF(k)
83              ENDIF              ENDIF
84             ENDIF             ENDIF
85            ENDDO            ENDDO
# Line 92  C Impose minimum size (dimensional) Line 92  C Impose minimum size (dimensional)
92  C     hFacW and hFacS (at U and V points)  C     hFacW and hFacS (at U and V points)
93        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
94         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
95          DO K=1, Nz          DO K=1, Nr
96           DO J=1,sNy           DO J=1,sNy
97            DO I=1,sNx            DO I=1,sNx
98             hFacW(I,J,K,bi,bj)=             hFacW(I,J,K,bi,bj)=
# Line 110  C     hFacW and hFacS (at U and V points Line 110  C     hFacW and hFacS (at U and V points
110  C     Masks and reciprocals of hFac[CWS]  C     Masks and reciprocals of hFac[CWS]
111        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
112         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
113          DO K=1,Nz          DO K=1,Nr
114           DO J=1,sNy           DO J=1,sNy
115            DO I=1,sNx            DO I=1,sNx
116             IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN
117              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)
118             ELSE             ELSE
119              rHFacC(I,J,K,bi,bj) = 0. D0              recip_HFacC(I,J,K,bi,bj) = 0. D0
120             ENDIF             ENDIF
121             IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN
122              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)
123              maskW(I,J,K,bi,bj) = 1. D0              maskW(I,J,K,bi,bj) = 1. D0
124             ELSE             ELSE
125              rHFacW(I,J,K,bi,bj) = 0. D0              recip_HFacW(I,J,K,bi,bj) = 0. D0
126              maskW(I,J,K,bi,bj) = 0.0 D0              maskW(I,J,K,bi,bj) = 0.0 D0
127             ENDIF             ENDIF
128             IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN             IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN
129              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)
130              maskS(I,J,K,bi,bj) = 1. D0              maskS(I,J,K,bi,bj) = 1. D0
131             ELSE             ELSE
132              rHFacS(I,J,K,bi,bj) = 0. D0              recip_HFacS(I,J,K,bi,bj) = 0. D0
133              maskS(I,J,K,bi,bj) = 0. D0              maskS(I,J,K,bi,bj) = 0. D0
134             ENDIF             ENDIF
135            ENDDO            ENDDO
# Line 137  C     Masks and reciprocals of hFac[CWS] Line 137  C     Masks and reciprocals of hFac[CWS]
137          ENDDO          ENDDO
138         ENDDO         ENDDO
139        ENDDO        ENDDO
140        _EXCH_XYZ_R4(rHFacC    , myThid )        _EXCH_XYZ_R4(recip_HFacC    , myThid )
141        _EXCH_XYZ_R4(rHFacW    , myThid )        _EXCH_XYZ_R4(recip_HFacW    , myThid )
142        _EXCH_XYZ_R4(rHFacS    , myThid )        _EXCH_XYZ_R4(recip_HFacS    , myThid )
143        _EXCH_XYZ_R4(maskW    , myThid )        _EXCH_XYZ_R4(maskW    , myThid )
144        _EXCH_XYZ_R4(maskS    , myThid )        _EXCH_XYZ_R4(maskS    , myThid )
145    
# Line 148  C     Calculate recipricols grid lengths Line 148  C     Calculate recipricols grid lengths
148         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
149          DO J=1,sNy          DO J=1,sNy
150           DO I=1,sNx           DO I=1,sNx
151            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)
152            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)
153            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)
154            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)
155            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)
156            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)
157            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)
158            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)
159           ENDDO           ENDDO
160          ENDDO          ENDDO
161         ENDDO         ENDDO
162        ENDDO        ENDDO
163        _EXCH_XY_R4(rDxG, myThid )        _EXCH_XY_R4(recip_dxG, myThid )
164        _EXCH_XY_R4(rDyG, myThid )        _EXCH_XY_R4(recip_dyG, myThid )
165        _EXCH_XY_R4(rDxC, myThid )        _EXCH_XY_R4(recip_dxC, myThid )
166        _EXCH_XY_R4(rDyC, myThid )        _EXCH_XY_R4(recip_dyC, myThid )
167        _EXCH_XY_R4(rDxF, myThid )        _EXCH_XY_R4(recip_dxF, myThid )
168        _EXCH_XY_R4(rDyF, myThid )        _EXCH_XY_R4(recip_dyF, myThid )
169        _EXCH_XY_R4(rDxV, myThid )        _EXCH_XY_R4(recip_dxV, myThid )
170        _EXCH_XY_R4(rDyU, myThid )        _EXCH_XY_R4(recip_dyU, myThid )
171    
172  C  C
173        RETURN        RETURN
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22