/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/cg2d.F
ViewVC logotype

Diff of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/cg2d.F

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

revision 1.3 by utke, Thu Jan 11 15:19:59 2007 UTC revision 1.5 by utke, Tue May 8 19:17:23 2007 UTC
# Line 44  C     === Global data === Line 44  C     === Global data ===
44  #include "SIZE.h"  #include "SIZE.h"
45  #include "EEPARAMS.h"  #include "EEPARAMS.h"
46  #include "PARAMS.h"  #include "PARAMS.h"
 #include "GRID.h"  
47  #include "CG2D.h"  #include "CG2D.h"
48  #include "SURFACE.h"  c#include "GRID.h"
49    c#include "SURFACE.h"
50    
51  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
52  C     === Routine arguments ===  C     === Routine arguments ===
# Line 92  c     INTEGER ks Line 92  c     INTEGER ks
92        _RL    sumRHS,sumRHStile        _RL    sumRHS,sumRHStile
93        _RL    rhsMax        _RL    rhsMax
94        _RL    rhsNorm        _RL    rhsNorm
95          CHARACTER*(MAX_LEN_MBUF) msgBuf
96  CEOP  CEOP
97    
98    
# Line 172  c         ks = ksurfC(I,J,bi,bj) Line 173  c         ks = ksurfC(I,J,bi,bj)
173       &    +aW2d(I+1,J  ,bi,bj)*cg2d_x(I+1,J  ,bi,bj)       &    +aW2d(I+1,J  ,bi,bj)*cg2d_x(I+1,J  ,bi,bj)
174       &    +aS2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J-1,bi,bj)       &    +aS2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J-1,bi,bj)
175       &    +aS2d(I  ,J+1,bi,bj)*cg2d_x(I  ,J+1,bi,bj)       &    +aS2d(I  ,J+1,bi,bj)*cg2d_x(I  ,J+1,bi,bj)
176       &    -aW2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)       &    +aC2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)
      &    -aW2d(I+1,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)  
      &    -aS2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)  
      &    -aS2d(I  ,J+1,bi,bj)*cg2d_x(I  ,J  ,bi,bj)  
      &    -freeSurfFac*_rA(i,j,bi,bj)*recip_Bo(i,j,bi,bj)*  
      &     cg2d_x(I  ,J  ,bi,bj)/deltaTMom/deltaTfreesurf*cg2dNorm  
177       &    )       &    )
178            errTile        = errTile        +  c    &    -aW2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)
179       &     cg2d_r(I,J,bi,bj)*cg2d_r(I,J,bi,bj)  c    &    -aW2d(I+1,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)
180            sumRHStile        = sumRHStile        +  c    &    -aS2d(I  ,J  ,bi,bj)*cg2d_x(I  ,J  ,bi,bj)
181       &     cg2d_b(I,J,bi,bj)  c    &    -aS2d(I  ,J+1,bi,bj)*cg2d_x(I  ,J  ,bi,bj)
182    c    &    -freeSurfFac*_rA(i,j,bi,bj)*deepFac2F(ks)*recip_Bo(i,j,bi,bj)
183    c    &                        *cg2d_x(I  ,J  ,bi,bj)
184    c    &                        /deltaTMom/deltaTfreesurf*cg2dNorm
185    c    &    )
186              errTile    = errTile + cg2d_r(I,J,bi,bj)*cg2d_r(I,J,bi,bj)
187              sumRHStile = sumRHStile + cg2d_b(I,J,bi,bj)
188           ENDDO           ENDDO
189          ENDDO          ENDDO
190          sumRHS = sumRHS + sumRHStile          sumRHS = sumRHS + sumRHStile
191          err    = err    + errTile          err    = err    + errTile
192         ENDDO         ENDDO
193        ENDDO        ENDDO
 C     _EXCH_XY_R8( cg2d_r, myThid )  
194  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
195        CALL EXCH_XY_O1_R8_JAM( cg2d_r )        CALL EXCH_XY_O1_R8_JAM( cg2d_r )
196  #else  #else
197        CALL EXCH_XY_RL( cg2d_r, myThid )        CALL EXCH_XY_RL( cg2d_r, myThid )
198  #endif  #endif
 C     _EXCH_XY_R8( cg2d_s, myThid )  
199  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
200        CALL EXCH_XY_O1_R8_JAM( cg2d_s )        CALL EXCH_XY_O1_R8_JAM( cg2d_s )
201  #else  #else
# Line 301  c          ks = ksurfC(I,J,bi,bj) Line 301  c          ks = ksurfC(I,J,bi,bj)
301       &    +aW2d(I+1,J  ,bi,bj)*cg2d_s(I+1,J  ,bi,bj)       &    +aW2d(I+1,J  ,bi,bj)*cg2d_s(I+1,J  ,bi,bj)
302       &    +aS2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J-1,bi,bj)       &    +aS2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J-1,bi,bj)
303       &    +aS2d(I  ,J+1,bi,bj)*cg2d_s(I  ,J+1,bi,bj)       &    +aS2d(I  ,J+1,bi,bj)*cg2d_s(I  ,J+1,bi,bj)
304       &    -aW2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)       &    +aC2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)
305       &    -aW2d(I+1,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)  c    &    -aW2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)
306       &    -aS2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)  c    &    -aW2d(I+1,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)
307       &    -aS2d(I  ,J+1,bi,bj)*cg2d_s(I  ,J  ,bi,bj)  c    &    -aS2d(I  ,J  ,bi,bj)*cg2d_s(I  ,J  ,bi,bj)
308       &    -freeSurfFac*_rA(i,j,bi,bj)*recip_Bo(i,j,bi,bj)*  c    &    -aS2d(I  ,J+1,bi,bj)*cg2d_s(I  ,J  ,bi,bj)
309       &     cg2d_s(I  ,J  ,bi,bj)/deltaTMom/deltaTfreesurf*cg2dNorm  c    &    -freeSurfFac*_rA(i,j,bi,bj)*deepFac2F(ks)*recip_Bo(i,j,bi,bj)
310    c    &                        *cg2d_s(I  ,J  ,bi,bj)
311    c    &                        /deltaTMom/deltaTfreesurf*cg2dNorm
312            alphaTile = alphaTile+cg2d_s(I,J,bi,bj)*cg2d_q(I,J,bi,bj)            alphaTile = alphaTile+cg2d_s(I,J,bi,bj)*cg2d_q(I,J,bi,bj)
313            ENDDO            ENDDO
314           ENDDO           ENDDO
# Line 343  C      Now compute "interior" points. Line 345  C      Now compute "interior" points.
345         err = SQRT(err)         err = SQRT(err)
346         actualIts      = it2d         actualIts      = it2d
347         actualResidual = err         actualResidual = err
348  C      _EXCH_XY_R8(cg2d_r, myThid )         IF ( debugLevel.GT.debLevB ) THEN
349    c       IF ( DIFFERENT_MULTIPLE(monitorFreq,myTime,deltaTClock)
350    c    &     ) THEN
351            _BEGIN_MASTER( myThid )
352            WRITE(msgBuf,'(A,I6,A,1PE21.14)')
353         &    ' cg2d: iter=', actualIts, ' ; resid.= ', actualResidual
354            CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
355            _END_MASTER( myThid )
356    c       ENDIF
357           ENDIF
358  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
359        CALL EXCH_XY_O1_R8_JAM( cg2d_r )        CALL EXCH_XY_O1_R8_JAM( cg2d_r )
360  #else  #else
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22