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

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

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

revision 1.14 by edhill, Tue Dec 14 16:54:08 2004 UTC revision 1.15 by jmc, Fri Feb 4 19:30:33 2005 UTC
# Line 90  C     I, J, N     - Loop counters ( N co Line 90  C     I, J, N     - Loop counters ( N co
90        INTEGER bi, bj                      INTEGER bi, bj              
91        INTEGER I, J, K, it3d        INTEGER I, J, K, it3d
92        INTEGER KM1, KP1        INTEGER KM1, KP1
93        _RL    err        _RL    err, errTile
94        _RL    eta_qrN        _RL    eta_qrN, eta_qrNtile
95        _RL    eta_qrNM1        _RL    eta_qrNM1
96        _RL    cgBeta        _RL    cgBeta
97        _RL    alpha        _RL    alpha , alphaTile
98        _RL    sumRHS        _RL    sumRHS, sumRHStile
99        _RL    rhsMax        _RL    rhsMax
100        _RL    rhsNorm        _RL    rhsNorm
101    
# Line 154  C--   Initial residual calculation (with Line 154  C--   Initial residual calculation (with
154        sumRHS = 0. _d 0        sumRHS = 0. _d 0
155        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
156         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
157            errTile    = 0. _d 0
158            sumRHStile = 0. _d 0
159          DO K=1,Nr          DO K=1,Nr
160           KM1 = K-1           KM1 = K-1
161           IF ( K .EQ. 1 ) KM1 = 1           IF ( K .EQ. 1 ) KM1 = 1
# Line 180  C--   Initial residual calculation (with Line 182  C--   Initial residual calculation (with
182       &     -aV3d(I  ,J  ,KP1,bi,bj)*cg3d_x(I  ,J  ,K  ,bi,bj)       &     -aV3d(I  ,J  ,KP1,bi,bj)*cg3d_x(I  ,J  ,K  ,bi,bj)
183       &     -topLevTerm*_rA(I,J,bi,bj)*cg3d_x(I,J,K,bi,bj)       &     -topLevTerm*_rA(I,J,bi,bj)*cg3d_x(I,J,K,bi,bj)
184       &     )       &     )
185             err = err             errTile = errTile
186       &     +cg3d_r(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)       &     +cg3d_r(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)
187             sumRHS = sumRHS             sumRHStile = sumRHStile
188       &     +cg3d_b(I,J,K,bi,bj)       &     +cg3d_b(I,J,K,bi,bj)
189            ENDDO            ENDDO
190           ENDDO           ENDDO
191          ENDDO          ENDDO
192            err    = err    + errTile
193            sumRHS = sumRHS + sumRHStile
194         ENDDO         ENDDO
195        ENDDO        ENDDO
196  C     _EXCH_XYZ_R8( cg3d_r, myThid )  C     _EXCH_XYZ_R8( cg3d_r, myThid )
# Line 216  C     _EXCH_XYZ_R8( cg3d_s, myThid ) Line 220  C     _EXCH_XYZ_R8( cg3d_s, myThid )
220        _GLOBAL_SUM_R8( sumRHS, myThid )        _GLOBAL_SUM_R8( sumRHS, myThid )
221        _GLOBAL_SUM_R8( err   , myThid )        _GLOBAL_SUM_R8( err   , myThid )
222                
223        _BEGIN_MASTER( myThid )        IF ( debugLevel .GE. debLevZero ) THEN
224        write(*,'(A,1P2E22.14)')          _BEGIN_MASTER( myThid )
225            write(*,'(A,1P2E22.14)')
226       &     ' cg3d: Sum(rhs),rhsMax = ',sumRHS,rhsMax       &     ' cg3d: Sum(rhs),rhsMax = ',sumRHS,rhsMax
227        _END_MASTER( myThid )          _END_MASTER( myThid )
228          ENDIF
229    
230        actualIts      = 0        actualIts      = 0
231        actualResidual = SQRT(err)        actualResidual = SQRT(err)
# Line 250  C            want eta_qrN for the interi Line 256  C            want eta_qrN for the interi
256         eta_qrN = 0. _d 0         eta_qrN = 0. _d 0
257         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
258          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
259             eta_qrNtile = 0. _d 0
260           DO K=1,1           DO K=1,1
261            DO J=1-1,sNy+1            DO J=1-1,sNy+1
262             DO I=1-1,sNx+1             DO I=1-1,sNx+1
# Line 279  caja       ENDDO Line 286  caja       ENDDO
286  caja      ENDIF  caja      ENDIF
287            DO J=1,sNy            DO J=1,sNy
288             DO I=1,sNx             DO I=1,sNx
289              eta_qrN = eta_qrN              eta_qrNtile = eta_qrNtile
290       &      +cg3d_q(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)       &      +cg3d_q(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)
291             ENDDO             ENDDO
292            ENDDO            ENDDO
# Line 294  caja      ENDIF Line 301  caja      ENDIF
301            ENDDO            ENDDO
302            DO J=1,sNy            DO J=1,sNy
303             DO I=1,sNx             DO I=1,sNx
304              eta_qrN = eta_qrN              eta_qrNtile = eta_qrNtile
305       &      +cg3d_q(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)       &      +cg3d_q(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)
306             ENDDO             ENDDO
307            ENDDO            ENDDO
308           ENDDO           ENDDO
309             eta_qrN = eta_qrN + eta_qrNtile
310          ENDDO          ENDDO
311         ENDDO         ENDDO
312  caja  caja
# Line 347  C==    q = A.s Line 355  C==    q = A.s
355       &      (horiVertRatio/gravity)/deltaTMom/deltaTMom       &      (horiVertRatio/gravity)/deltaTMom/deltaTMom
356         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
357          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
358             alphaTile = 0. _d 0
359           IF ( Nr .GT. 1 ) THEN           IF ( Nr .GT. 1 ) THEN
360            DO K=1,1            DO K=1,1
361             DO J=1,sNy             DO J=1,sNy
# Line 363  C==    q = A.s Line 372  C==    q = A.s
372       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
373       &      -aV3d(I  ,J  ,K+1,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aV3d(I  ,J  ,K+1,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
374       &      -topLevTerm*_rA(I,J,bi,bj)*cg3d_s(I,J,K,bi,bj)       &      -topLevTerm*_rA(I,J,bi,bj)*cg3d_s(I,J,K,bi,bj)
375               alpha = alpha+cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)               alphaTile = alphaTile
376         &                 +cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)
377              ENDDO              ENDDO
378             ENDDO             ENDDO
379            ENDDO            ENDDO
# Line 381  C==    q = A.s Line 391  C==    q = A.s
391       &      -aS3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aS3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
392       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
393       &      -topLevTerm*_rA(I,J,bi,bj)*cg3d_s(I,J,K,bi,bj)       &      -topLevTerm*_rA(I,J,bi,bj)*cg3d_s(I,J,K,bi,bj)
394               alpha = alpha+cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)               alphaTile = alphaTile
395         &                 +cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)
396              ENDDO              ENDDO
397             ENDDO             ENDDO
398            ENDDO            ENDDO
# Line 402  C==    q = A.s Line 413  C==    q = A.s
413       &     -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &     -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
414       &     -aV3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &     -aV3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
415       &     -aV3d(I  ,J  ,K+1,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &     -aV3d(I  ,J  ,K+1,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
416              alpha = alpha+cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)              alphaTile = alphaTile
417         &                +cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)
418             ENDDO             ENDDO
419            ENDDO            ENDDO
420           ENDDO           ENDDO
# Line 421  C==    q = A.s Line 433  C==    q = A.s
433       &      -aS3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aS3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
434       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aS3d(I  ,J+1,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
435       &      -aV3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)       &      -aV3d(I  ,J  ,K  ,bi,bj)*cg3d_s(I  ,J  ,K  ,bi,bj)
436               alpha = alpha+cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)               alphaTile = alphaTile
437         &                 +cg3d_s(I,J,K,bi,bj)*cg3d_q(I,J,K,bi,bj)
438              ENDDO              ENDDO
439             ENDDO             ENDDO
440            ENDDO            ENDDO
441           ENDIF           ENDIF
442             alpha = alpha + alphaTile
443          ENDDO          ENDDO
444         ENDDO         ENDDO
445         _GLOBAL_SUM_R8(alpha,myThid)         _GLOBAL_SUM_R8(alpha,myThid)
# Line 442  C      Now compute "interior" points. Line 456  C      Now compute "interior" points.
456         err = 0. _d 0         err = 0. _d 0
457         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
458          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
459            errTile    = 0. _d 0
460           DO K=1,Nr           DO K=1,Nr
461            DO J=1,sNy            DO J=1,sNy
462             DO I=1,sNx             DO I=1,sNx
# Line 449  C      Now compute "interior" points. Line 464  C      Now compute "interior" points.
464       &            +alpha*cg3d_s(I,J,K,bi,bj)       &            +alpha*cg3d_s(I,J,K,bi,bj)
465              cg3d_r(I,J,K,bi,bj)=cg3d_r(I,J,K,bi,bj)              cg3d_r(I,J,K,bi,bj)=cg3d_r(I,J,K,bi,bj)
466       &            -alpha*cg3d_q(I,J,K,bi,bj)       &            -alpha*cg3d_q(I,J,K,bi,bj)
467              err = err+cg3d_r(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)             errTile = errTile
468         &             +cg3d_r(I,J,K,bi,bj)*cg3d_r(I,J,K,bi,bj)
469             ENDDO             ENDDO
470            ENDDO            ENDDO
471           ENDDO           ENDDO
472             err = err + errTile
473          ENDDO          ENDDO
474         ENDDO         ENDDO
475    
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22