/[MITgcm]/MITgcm/pkg/mom_common/mom_v_implicit_r.F
ViewVC logotype

Diff of /MITgcm/pkg/mom_common/mom_v_implicit_r.F

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

revision 1.5 by jmc, Thu Aug 14 16:44:40 2014 UTC revision 1.6 by jmc, Wed Oct 5 00:04:31 2016 UTC
# Line 36  C     == Routine Arguments == Line 36  C     == Routine Arguments ==
36    
37  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
38  C     == Local variables ==  C     == Local variables ==
39    C iMin,iMax,jMin,jMax :: computational domain
40    C i,j,k     :: loop indices
41    C a5d       :: 2nd  lower diagonal of the pentadiagonal matrix
42    C b5d       :: 1rst lower diagonal of the pentadiagonal matrix
43    C c5d       :: main diagonal       of the pentadiagonal matrix
44    C d5d       :: 1rst upper diagonal of the pentadiagonal matrix
45    C e5d       :: 2nd  upper diagonal of the pentadiagonal matrix
46    C rTrans    :: vertical volume transport at interface k
47    C diagonalNumber :: number of non-zero diagonals in the matrix
48    C errCode   :: > 0 if singular matrix
49        INTEGER iMin,iMax,jMin,jMax        INTEGER iMin,iMax,jMin,jMax
50          PARAMETER( iMin = 1, iMax = sNx )
51          PARAMETER( jMin = 1, jMax = sNy+1 )
52        INTEGER i,j,k        INTEGER i,j,k
53        INTEGER diagonalNumber, errCode        INTEGER diagonalNumber, errCode
54  c     _RL a5d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  c     _RL a5d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
# Line 59  C     Solve for V-component : Line 71  C     Solve for V-component :
71  C----------------------------  C----------------------------
72    
73  C--   Initialise  C--   Initialise
       iMin = 1  
       jMin = 1  
       iMax = sNx  
       jMax = sNy+1  
74        DO k=1,Nr        DO k=1,Nr
75         DO j=1-OLy,sNy+OLy         DO j=1-OLy,sNy+OLy
76          DO i=1-OLx,sNx+OLx          DO i=1-OLx,sNx+OLx
# Line 84  C-     1rst lower diagonal : Line 92  C-     1rst lower diagonal :
92         DO k=2,Nr         DO k=2,Nr
93          DO j=jMin,jMax          DO j=jMin,jMax
94           DO i=iMin,iMax           DO i=iMin,iMax
95            IF (maskS(i,j,k-1,bi,bj).EQ.1.)            IF (maskS(i,j,k-1,bi,bj).EQ.oneRS)
96       &     b5d(i,j,k) = -deltaTMom       &     b5d(i,j,k) = -deltaTMom
97       &                  *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &                  *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
98         &                  *recip_deepFac2C(k)*recip_rhoFacC(k)
99       &                  *kappaRV(i,j, k )*recip_drC( k )       &                  *kappaRV(i,j, k )*recip_drC( k )
100         &                  *deepFac2F( k )*rhoFacF( k )
101    
102           ENDDO           ENDDO
103          ENDDO          ENDDO
104         ENDDO         ENDDO
# Line 95  C-     1rst upper diagonal : Line 106  C-     1rst upper diagonal :
106         DO k=1,Nr-1         DO k=1,Nr-1
107          DO j=jMin,jMax          DO j=jMin,jMax
108           DO i=iMin,iMax           DO i=iMin,iMax
109            IF (maskS(i,j,k+1,bi,bj).EQ.1.)            IF (maskS(i,j,k+1,bi,bj).EQ.oneRS)
110       &     d5d(i,j,k) = -deltaTMom       &     d5d(i,j,k) = -deltaTMom
111       &                 *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &                  *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
112       &                 *KappaRV(i,j,k+1)*recip_drC(k+1)       &                  *recip_deepFac2C(k)*recip_rhoFacC(k)
113         &                  *kappaRV(i,j,k+1)*recip_drC(k+1)
114         &                  *deepFac2F(k+1)*rhoFacF(k+1)
115           ENDDO           ENDDO
116          ENDDO          ENDDO
117         ENDDO         ENDDO
# Line 106  C-     Main diagonal : Line 119  C-     Main diagonal :
119         DO k=1,Nr         DO k=1,Nr
120          DO j=jMin,jMax          DO j=jMin,jMax
121           DO i=iMin,iMax           DO i=iMin,iMax
122             c5d(i,j,k) = 1. _d 0 - b5d(i,j,k) - d5d(i,j,k)             c5d(i,j,k) = 1. _d 0 - ( b5d(i,j,k) + d5d(i,j,k) )
123           ENDDO           ENDDO
124          ENDDO          ENDDO
125         ENDDO         ENDDO
# Line 126  C--   end if implicitDiffusion Line 139  C--   end if implicitDiffusion
139       &                                 *maskC(i, j ,k-1,bi,bj)       &                                 *maskC(i, j ,k-1,bi,bj)
140       &              + wVel(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)       &              + wVel(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
141       &                                 *maskC(i,j-1,k-1,bi,bj)       &                                 *maskC(i,j-1,k-1,bi,bj)
142       &                               )       &                               )*deepFac2F(k)*rhoFacF(k)
143             ENDDO             ENDDO
144            ENDDO            ENDDO
145    
# Line 145  C-          space Centered/Upwind advect Line 158  C-          space Centered/Upwind advect
158                b5d(i,j,k) = b5d(i,j,k)                b5d(i,j,k) = b5d(i,j,k)
159       &                   - (rCenter+rUpwind)       &                   - (rCenter+rUpwind)
160       &                     *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &                     *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
161         &                     *recip_deepFac2C(k)*recip_rhoFacC(k)
162                c5d(i,j,k) = c5d(i,j,k)                c5d(i,j,k) = c5d(i,j,k)
163       &                   + (rCenter+rUpwind)       &                   + (rCenter+rUpwind)
164       &                     *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &                     *_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
165         &                     *recip_deepFac2C(k)*recip_rhoFacC(k)
166                c5d(i,j,k-1) = c5d(i,j,k-1)                c5d(i,j,k-1) = c5d(i,j,k-1)
167       &                   - (rCenter-rUpwind)       &                   - (rCenter-rUpwind)
168       &                     *_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)       &                     *_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)
169         &                     *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
170                d5d(i,j,k-1) = d5d(i,j,k-1)                d5d(i,j,k-1) = d5d(i,j,k-1)
171       &                   + (rCenter-rUpwind)       &                   + (rCenter-rUpwind)
172       &                     *_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)       &                     *_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)
173         &                     *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
174               ENDDO               ENDDO
175              ENDDO              ENDDO
176            ELSE            ELSE
# Line 164  C-          space Centered advection sch Line 181  C-          space Centered advection sch
181       &                           *recip_rAs(i,j,bi,bj)*rkSign       &                           *recip_rAs(i,j,bi,bj)*rkSign
182                b5d(i,j,k) = b5d(i,j,k)                b5d(i,j,k) = b5d(i,j,k)
183       &            - rCenter*_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &            - rCenter*_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
184         &                     *recip_deepFac2C(k)*recip_rhoFacC(k)
185                c5d(i,j,k) = c5d(i,j,k)                c5d(i,j,k) = c5d(i,j,k)
186       &            - rCenter*_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &            - rCenter*_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
187         &                     *recip_deepFac2C(k)*recip_rhoFacC(k)
188                c5d(i,j,k-1) = c5d(i,j,k-1)                c5d(i,j,k-1) = c5d(i,j,k-1)
189       &            + rCenter*_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)       &            + rCenter*_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)
190         &                     *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
191                d5d(i,j,k-1) = d5d(i,j,k-1)                d5d(i,j,k-1) = d5d(i,j,k-1)
192       &            + rCenter*_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)       &            + rCenter*_recip_hFacS(i,j,k-1,bi,bj)*recip_drF(k-1)
193         &                     *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
194               ENDDO               ENDDO
195              ENDDO              ENDDO
196              STOP 'MOM_IMPLICIT_R: Flux Form not yet finished.'              STOP 'MOM_IMPLICIT_R: Flux Form not yet finished.'
# Line 212  C         otherwise counter is not incre Line 233  C         otherwise counter is not incre
233            ELSE            ELSE
234              DO j=jMin,jMax              DO j=jMin,jMax
235               DO i=iMin,iMax               DO i=iMin,iMax
236                 vf(i,j) =                 vf(i,j) = -rAs(i,j,bi,bj)*deepFac2F(k)*rhoFacF(k)
237       &             -KappaRV(i,j,k)*rAs(i,j,bi,bj)*recip_drC(k)       &            * kappaRV(i,j,k)*recip_drC(k)*rkSign
238       &            * (gV(i,j,k,bi,bj) - gV(i,j,k-1,bi,bj))*rkSign       &            * (gV(i,j,k,bi,bj) - gV(i,j,k-1,bi,bj))
239       &            *_maskS(i,j,k,bi,bj)       &            *_maskS(i,j,k,bi,bj)
240       &            *_maskS(i,j,k-1,bi,bj)       &            *_maskS(i,j,k-1,bi,bj)
241               ENDDO               ENDDO

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.22