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

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

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

revision 1.1 by heimbach, Wed Jun 7 01:45:42 2006 UTC revision 1.2 by jmc, Tue Apr 28 18:01:14 2009 UTC
# Line 141  C--   Initialise inverter Line 141  C--   Initialise inverter
141        recip_eta_qrNM1 = 1./eta_qrNM1        recip_eta_qrNM1 = 1./eta_qrNM1
142    
143  CcnhDebugStarts  CcnhDebugStarts
144  C     _EXCH_XY_R8( cg2d_b, myThid )  C     _EXCH_XY_RL( cg2d_b, myThid )
145  C     CALL PLOT_FIELD_XYRL( cg2d_b, 'CG2D.0 CG2D_B' , 1, myThid )  C     CALL PLOT_FIELD_XYRL( cg2d_b, 'CG2D.0 CG2D_B' , 1, myThid )
146  C     suff = 'unnormalised'  C     suff = 'unnormalised'
147  C     CALL WRITE_FLD_XY_RL (  'cg2d_b.',suff,    cg2d_b, 1, myThid)  C     CALL WRITE_FLD_XY_RL (  'cg2d_b.',suff,    cg2d_b, 1, myThid)
# Line 167  CADJ STORE cg2d_b = comlev1_cg2d, key = Line 167  CADJ STORE cg2d_b = comlev1_cg2d, key =
167        IF (cg2dNormaliseRHS) THEN        IF (cg2dNormaliseRHS) THEN
168  C     -  Normalise RHS :  C     -  Normalise RHS :
169  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
170  C     _GLOBAL_MAX_R8( rhsMax, myThid )  C     _GLOBAL_MAX_RL( rhsMax, myThid )
171        rhsMaxGlobal=1.        rhsMaxGlobal=1.
172  #else  #else
173  #ifdef ALLOW_CONST_RHSMAX  #ifdef ALLOW_CONST_RHSMAX
174        rhsMaxGlobal=1.        rhsMaxGlobal=1.
175  #else  #else
176        rhsMaxGlobal=rhsMax        rhsMaxGlobal=rhsMax
177        _GLOBAL_MAX_R8( rhsMaxGlobal, myThid )        _GLOBAL_MAX_RL( rhsMaxGlobal, myThid )
178  #endif /* ALLOW_CONST_RHSMAX */  #endif /* ALLOW_CONST_RHSMAX */
179  #endif  #endif
180  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 204  C- end Normalise RHS Line 204  C- end Normalise RHS
204        ENDIF        ENDIF
205    
206  C--   Update overlaps  C--   Update overlaps
207        _EXCH_XY_R8( cg2d_b, myThid )        _EXCH_XY_RL( cg2d_b, myThid )
208        _EXCH_XY_R8( cg2d_x, myThid )        _EXCH_XY_RL( cg2d_x, myThid )
209  CcnhDebugStarts  CcnhDebugStarts
210  C     CALL PLOT_FIELD_XYRL( cg2d_b, 'CG2D.1 CG2D_B' , 1, myThid )  C     CALL PLOT_FIELD_XYRL( cg2d_b, 'CG2D.1 CG2D_B' , 1, myThid )
211  C     suff = 'normalised'  C     suff = 'normalised'
# Line 251  CML     &     cg2d_x(I  ,J  ,bi,bj)/delt Line 251  CML     &     cg2d_x(I  ,J  ,bi,bj)/delt
251        CALL EXCH_XY_O1_R8_JAM( cg2d_r )        CALL EXCH_XY_O1_R8_JAM( cg2d_r )
252        CALL EXCH_XY_O1_R8_JAM( cg2d_s )        CALL EXCH_XY_O1_R8_JAM( cg2d_s )
253  #else  #else
254        _EXCH_XY_R8( cg2d_r, myThid )        _EXCH_XY_RL( cg2d_r, myThid )
255        _EXCH_XY_R8( cg2d_s, myThid )        _EXCH_XY_RL( cg2d_s, myThid )
256  #endif  #endif
257         _GLOBAL_SUM_R8( sumRHS, myThid )         _GLOBAL_SUM_RL( sumRHS, myThid )
258         _GLOBAL_SUM_R8( err_sq, myThid )         _GLOBAL_SUM_RL( err_sq, myThid )
259         if ( err_sq .ne. 0. ) then         if ( err_sq .ne. 0. ) then
260            err = SQRT(err_sq)            err = SQRT(err_sq)
261         else         else
# Line 329  CcnhDebugEnds Line 329  CcnhDebugEnds
329          ENDDO          ENDDO
330         ENDDO         ENDDO
331    
332         _GLOBAL_SUM_R8(eta_qrN, myThid)         _GLOBAL_SUM_RL(eta_qrN, myThid)
333  CcnhDebugStarts  CcnhDebugStarts
334  C      WRITE(*,*) ' CG2D_NSA: Iteration ',it2d-1,' eta_qrN = ',eta_qrN  C      WRITE(*,*) ' CG2D_NSA: Iteration ',it2d-1,' eta_qrN = ',eta_qrN
335  CcnhDebugEnds  CcnhDebugEnds
# Line 364  C--    processes. Line 364  C--    processes.
364  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
365        CALL EXCH_XY_O1_R8_JAM( cg2d_s )        CALL EXCH_XY_O1_R8_JAM( cg2d_s )
366  #else  #else
367         _EXCH_XY_R8( cg2d_s, myThid )         _EXCH_XY_RL( cg2d_s, myThid )
368  #endif  #endif
369    
370  C==    Evaluate laplace operator on conjugate gradient vector  C==    Evaluate laplace operator on conjugate gradient vector
# Line 397  CML     &     cg2d_s(I  ,J  ,bi,bj)/delt Line 397  CML     &     cg2d_s(I  ,J  ,bi,bj)/delt
397           ENDDO           ENDDO
398          ENDDO          ENDDO
399         ENDDO         ENDDO
400         _GLOBAL_SUM_R8(alpha_aux,myThid)         _GLOBAL_SUM_RL(alpha_aux,myThid)
401  CcnhDebugStarts  CcnhDebugStarts
402  C      WRITE(*,*) ' CG2D_NSA: Iteration ',it2d-1,' SUM(s*q)= ',alpha_aux  C      WRITE(*,*) ' CG2D_NSA: Iteration ',it2d-1,' SUM(s*q)= ',alpha_aux
403  CcnhDebugEnds  CcnhDebugEnds
# Line 427  CADJ STORE cg2d_r = comlev1_cg2d_iter, k Line 427  CADJ STORE cg2d_r = comlev1_cg2d_iter, k
427          ENDDO          ENDDO
428         ENDDO         ENDDO
429    
430         _GLOBAL_SUM_R8( err_sq   , myThid )         _GLOBAL_SUM_RL( err_sq   , myThid )
431         if ( err_sq .ne. 0. ) then         if ( err_sq .ne. 0. ) then
432            err = SQRT(err_sq)            err = SQRT(err_sq)
433         else         else
# Line 439  CADJ STORE cg2d_r = comlev1_cg2d_iter, k Line 439  CADJ STORE cg2d_r = comlev1_cg2d_iter, k
439  #ifdef LETS_MAKE_JAM  #ifdef LETS_MAKE_JAM
440        CALL EXCH_XY_O1_R8_JAM( cg2d_r )        CALL EXCH_XY_O1_R8_JAM( cg2d_r )
441  #else  #else
442        _EXCH_XY_R8( cg2d_r, myThid )        _EXCH_XY_RL( cg2d_r, myThid )
443        _EXCH_XY_R8( cg2d_x, myThid )        _EXCH_XY_RL( cg2d_x, myThid )
444  #endif  #endif
445    
446  Cml   end of IF ( err .LT. cg2dTolerance ) THEN; ELSE  Cml   end of IF ( err .LT. cg2dTolerance ) THEN; ELSE
# Line 467  C--   Un-normalise the answer Line 467  C--   Un-normalise the answer
467    
468  C     The following exchange was moved up to solve_for_pressure  C     The following exchange was moved up to solve_for_pressure
469  C     for compatibility with TAMC.  C     for compatibility with TAMC.
470  C     _EXCH_XY_R8(cg2d_x, myThid )  C     _EXCH_XY_RL(cg2d_x, myThid )
471  c     _BEGIN_MASTER( myThid )  c     _BEGIN_MASTER( myThid )
472  c      WRITE(*,'(A,I6,1PE30.14)') ' CG2D_NSA iters, err = ',  c      WRITE(*,'(A,I6,1PE30.14)') ' CG2D_NSA iters, err = ',
473  c    & actualIts, actualResidual  c    & actualIts, actualResidual
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22