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

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

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

revision 1.2 by cnh, Fri Apr 24 02:05:41 1998 UTC revision 1.15 by cnh, Sun Feb 4 14:38:47 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6  CStartOfInterface  CStartOfInterface
7        SUBROUTINE INI_CARTESIAN_GRID( myThid )        SUBROUTINE INI_CARTESIAN_GRID( myThid )
# Line 33  C     | Under the cartesian grid mode pr Line 34  C     | Under the cartesian grid mode pr
34  C     | and Y are in metres. Disktance in Z are in m or Pa       |  C     | and Y are in metres. Disktance in Z are in m or Pa       |
35  C     | depending on the vertical gridding mode.                 |  C     | depending on the vertical gridding mode.                 |
36  C     \==========================================================/  C     \==========================================================/
37          IMPLICIT NONE
38    
39  C     === Global variables ===  C     === Global variables ===
40  #include "SIZE.h"  #include "SIZE.h"
# Line 47  CEndOfInterface Line 49  CEndOfInterface
49    
50  C     == Local variables ==  C     == Local variables ==
51  C     xG, yG - Global coordinate location.  C     xG, yG - Global coordinate location.
 C     zG  
52  C     xBase  - South-west corner location for process.  C     xBase  - South-west corner location for process.
53  C     yBase  C     yBase
54  C     zUpper - Work arrays for upper and lower  C     zUpper - Work arrays for upper and lower
# Line 61  C     bi,bj  - Loop counters Line 62  C     bi,bj  - Loop counters
62  C     zUpper - Temporary arrays holding z coordinates of  C     zUpper - Temporary arrays holding z coordinates of
63  C     zLower   upper and lower faces.  C     zLower   upper and lower faces.
64  C     I,J,K  C     I,J,K
65        _RL    xG, yG, zG        _RL    xGloc, yGloc
       _RL    phi  
       _RL    zUpper(Nz), zLower(Nz)  
66        _RL    xBase, yBase        _RL    xBase, yBase
67        INTEGER iG, jG        INTEGER iG, jG
68        INTEGER bi, bj        INTEGER bi, bj
69        INTEGER  I,  J, K        INTEGER  I,  J
70    
71  C--   Simple example of inialisation on cartesian grid  C--   Simple example of inialisation on cartesian grid
72  C--   First set coordinates of cell centers  C--   First set coordinates of cell centers
# Line 75  C     This operation is only performed a Line 74  C     This operation is only performed a
74  C     complex configurations it is usually OK to pass iG, jG to a custom  C     complex configurations it is usually OK to pass iG, jG to a custom
75  C     function and have it return xG and yG.  C     function and have it return xG and yG.
76  C     Set up my local grid first  C     Set up my local grid first
77          xC0 = 0. _d 0
78          yC0 = 0. _d 0
79        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
80         jG = myYGlobalLo + (bj-1)*sNy         jG = myYGlobalLo + (bj-1)*sNy
81         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 87  C     Set up my local grid first Line 88  C     Set up my local grid first
88          DO j=1,jG-1          DO j=1,jG-1
89           yBase = yBase + delY(j)           yBase = yBase + delY(j)
90          ENDDO          ENDDO
91          yG = yBase          yGloc = yBase
92          DO J=1,sNy          DO J=1,sNy
93           xG = xBase           xGloc = xBase
94           DO I=1,sNx           DO I=1,sNx
95            xc(I,J,bi,bj)  = xG + delX(iG+i-1)*0.5 _d 0            xG(I,J,bi,bj)  = xGloc
96            yc(I,J,bi,bj)  = yG + delY(jG+j-1)*0.5 _d 0            yG(I,J,bi,bj)  = yGloc
97            xG = xG + delX(iG+I-1)            xc(I,J,bi,bj)  = xGloc + delX(iG+i-1)*0.5 _d 0
98              yc(I,J,bi,bj)  = yGloc + delY(jG+j-1)*0.5 _d 0
99              xGloc = xGloc + delX(iG+I-1)
100            dxF(I,J,bi,bj) = delX(iG+i-1)            dxF(I,J,bi,bj) = delX(iG+i-1)
101            dyF(I,J,bi,bj) = delY(jG+j-1)            dyF(I,J,bi,bj) = delY(jG+j-1)
102           ENDDO           ENDDO
103           yG = yG + delY(jG+J-1)           yGloc = yGloc + delY(jG+J-1)
104          ENDDO          ENDDO
105         ENDDO         ENDDO
106        ENDDO        ENDDO
# Line 141  C     dxC, dyC is separation between cel Line 144  C     dxC, dyC is separation between cel
144         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
145          DO J=1,sNy          DO J=1,sNy
146           DO I=1,sNx           DO I=1,sNx
147            dxC(I,J,bi,bj)    = (dxF(I,J,bi,bj)+dxF(I-1,J,bi,bj))*0.5 D0            dxC(I,J,bi,bj)    = (dxF(I,J,bi,bj)+dxF(I-1,J,bi,bj))*0.5 _d 0
148            dyC(I,J,bi,bj)    = (dyF(I,J,bi,bj)+dyF(I,J-1,bi,bj))*0.5 D0            dyC(I,J,bi,bj)    = (dyF(I,J,bi,bj)+dyF(I,J-1,bi,bj))*0.5 _d 0
149           ENDDO           ENDDO
150          ENDDO          ENDDO
151         ENDDO         ENDDO
152        ENDDO        ENDDO
153        _EXCH_XY_R4(dxC, myThid )        _EXCH_XY_R4(dxC, myThid )
154        _EXCH_XY_R4(dyC, myThid )        _EXCH_XY_R4(dyC, myThid )
 C     Calculate recipricols  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO J=1,sNy  
          DO I=1,sNx  
           rDxG(I,J,bi,bj)=1.d0/dxG(I,J,bi,bj)  
           rDyG(I,J,bi,bj)=1.d0/dyG(I,J,bi,bj)  
           rDxC(I,J,bi,bj)=1.d0/dxC(I,J,bi,bj)  
           rDyC(I,J,bi,bj)=1.d0/dyC(I,J,bi,bj)  
           rDxF(I,J,bi,bj)=1.d0/dxF(I,J,bi,bj)  
           rDyF(I,J,bi,bj)=1.d0/dyF(I,J,bi,bj)  
           rDxV(I,J,bi,bj)=1.d0/dxV(I,J,bi,bj)  
           rDyU(I,J,bi,bj)=1.d0/dyU(I,J,bi,bj)  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
       _EXCH_XY_R4(rDxG, myThid )  
       _EXCH_XY_R4(rDyG, myThid )  
       _EXCH_XY_R4(rDxC, myThid )  
       _EXCH_XY_R4(rDyC, myThid )  
       _EXCH_XY_R4(rDxF, myThid )  
       _EXCH_XY_R4(rDyF, myThid )  
       _EXCH_XY_R4(rDxV, myThid )  
       _EXCH_XY_R4(rDyU, myThid )  
155  C     Calculate vertical face area  C     Calculate vertical face area
156        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
157         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
158          DO J=1,sNy          DO J=1,sNy
159           DO I=1,sNx           DO I=1,sNx
160            zA(I,J,bi,bj) = dxF(I,J,bi,bj)*dyF(I,J,bi,bj)            rA (I,J,bi,bj) = dxF(I,J,bi,bj)*dyF(I,J,bi,bj)
161              rAw(I,J,bi,bj) = dxC(I,J,bi,bj)*dyG(I,J,bi,bj)
162              rAs(I,J,bi,bj) = dxG(I,J,bi,bj)*dyC(I,J,bi,bj)
163              rAz(I,J,bi,bj) = dxV(I,J,bi,bj)*dyU(I,J,bi,bj)
164              tanPhiAtU(I,J,bi,bj) = 0. _d 0
165              tanPhiAtV(I,J,bi,bj) = 0. _d 0
166           ENDDO           ENDDO
167          ENDDO          ENDDO
168         ENDDO         ENDDO
169        ENDDO        ENDDO
170          _EXCH_XY_R4 (rA       , myThid )
171        DO bj = myByLo(myThid), myByHi(myThid)        _EXCH_XY_R4 (rAw      , myThid )
172         DO bi = myBxLo(myThid), myBxHi(myThid)        _EXCH_XY_R4 (rAs      , myThid )
173          DO K=1,Nz        _EXCH_XY_R4 (tanPhiAtU , myThid )
174           DO J=1,sNy        _EXCH_XY_R4 (tanPhiAtV , myThid )
           DO I=1,sNx  
            IF (HFacC(I,J,K,bi,bj) .NE. 0. D0 ) THEN  
             rHFacC(I,J,K,bi,bj) = 1. D0 / HFacC(I,J,K,bi,bj)  
            ELSE  
             rHFacC(I,J,K,bi,bj) = 0. D0  
            ENDIF  
            IF (HFacW(I,J,K,bi,bj) .NE. 0. D0 ) THEN  
             rHFacW(I,J,K,bi,bj) = 1. D0 / HFacW(I,J,K,bi,bj)  
             maskW(I,J,K,bi,bj) = 1. D0  
            ELSE  
             rHFacW(I,J,K,bi,bj) = 0. D0  
             maskW(I,J,K,bi,bj) = 0.0 D0  
            ENDIF  
            IF (HFacS(I,J,K,bi,bj) .NE. 0. D0 ) THEN  
             rHFacS(I,J,K,bi,bj) = 1. D0 / HFacS(I,J,K,bi,bj)  
             maskS(I,J,K,bi,bj) = 1. D0  
            ELSE  
             rHFacS(I,J,K,bi,bj) = 0. D0  
             maskS(I,J,K,bi,bj) = 0. D0  
            ENDIF  
           ENDDO  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 C     Now sync. and get/send edge regions that are shared with  
 C     other threads.  
       _EXCH_XYZ_R4(rHFacC    , myThid )  
       _EXCH_XYZ_R4(rHFacW    , myThid )  
       _EXCH_XYZ_R4(rHFacS    , myThid )  
       _EXCH_XYZ_R4(maskW    , myThid )  
       _EXCH_XYZ_R4(maskS    , myThid )  
175    
176  C  C
177        RETURN        RETURN
178        END        END
   
 C     $Id$  
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22