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

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

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

revision 1.4 by cnh, Mon May 25 18:01:32 1998 UTC revision 1.6 by adcroft, Mon Jun 22 15:26:25 1998 UTC
# Line 81  C     Set up my local grid first Line 81  C     Set up my local grid first
81  C     Note: In the spherical polar case delX and delY are given in  C     Note: In the spherical polar case delX and delY are given in
82  C           degrees and are relative to some starting latitude and  C           degrees and are relative to some starting latitude and
83  C           longitude - phiMin and thetaMin.  C           longitude - phiMin and thetaMin.
84          xC0 = thetaMin
85          yC0 = phiMin
86        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
87         jG = myYGlobalLo + (bj-1)*sNy         jG = myYGlobalLo + (bj-1)*sNy
88         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 183  C     Calculate recipricols Line 185  C     Calculate recipricols
185        _EXCH_XY_R4(rDyF, myThid )        _EXCH_XY_R4(rDyF, myThid )
186        _EXCH_XY_R4(rDxV, myThid )        _EXCH_XY_R4(rDxV, myThid )
187        _EXCH_XY_R4(rDyU, myThid )        _EXCH_XY_R4(rDyU, myThid )
188  C     Calculate vertical face area  C     Calculate vertical face area and trigonometric terms
189        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
190         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
191          DO J=1,sNy          DO J=1,sNy
# Line 193  C     Calculate vertical face area Line 195  C     Calculate vertical face area
195            latN = yc(i,j,bi,bj)+delY(jG)*0.5 _d 0            latN = yc(i,j,bi,bj)+delY(jG)*0.5 _d 0
196            zA(I,J,bi,bj) = dyF(I,J,bi,bj)            zA(I,J,bi,bj) = dyF(I,J,bi,bj)
197       &    *rSphere*(SIN(latN*deg2rad)-SIN(latS*deg2rad))       &    *rSphere*(SIN(latN*deg2rad)-SIN(latS*deg2rad))
198              tanPhiAtU(i,j,bi,bj)=tan(_yC(i,j,bi,bj)*deg2rad)
199              tanPhiAtV(i,j,bi,bj)=tan(latS*deg2rad)
200           ENDDO           ENDDO
201          ENDDO          ENDDO
202         ENDDO         ENDDO
203        ENDDO        ENDDO
204        _EXCH_XY_R4(zA, myThid )  
205          DO bj = myByLo(myThid), myByHi(myThid)
206           DO bi = myBxLo(myThid), myBxHi(myThid)
207            DO K=1,Nz
208             DO J=1,sNy
209              DO I=1,sNx
210               IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN
211                rHFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj)
212               ELSE
213                rHFacC(I,J,K,bi,bj) = 0. D0
214               ENDIF
215               IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN
216                rHFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj)
217                maskW(I,J,K,bi,bj) = 1. D0
218               ELSE
219                rHFacW(I,J,K,bi,bj) = 0. D0
220                maskW(I,J,K,bi,bj) = 0.0 D0
221               ENDIF
222               IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN
223                rHFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj)
224                maskS(I,J,K,bi,bj) = 1. D0
225               ELSE
226                rHFacS(I,J,K,bi,bj) = 0. D0
227                maskS(I,J,K,bi,bj) = 0. D0
228               ENDIF
229              ENDDO
230             ENDDO
231            ENDDO
232           ENDDO
233          ENDDO
234    C     Now sync. and get/send edge regions that are shared with
235    C     other threads.
236          _EXCH_XYZ_R4(rHFacC    , myThid )
237          _EXCH_XYZ_R4(rHFacW    , myThid )
238          _EXCH_XYZ_R4(rHFacS    , myThid )
239          _EXCH_XYZ_R4(maskW    , myThid )
240          _EXCH_XYZ_R4(maskS    , myThid )
241          _EXCH_XY_R4 (zA       , myThid )
242          _EXCH_XY_R4 (tanPhiAtU , myThid )
243          _EXCH_XY_R4 (tanPhiAtV , myThid )
244    
245  C  C
246        RETURN        RETURN
247        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22