Changeset 784 for trunk/NEMO/OPA_SRC/SOL/solsor.F90

Timestamp:

2008-01-08T12:05:25+01:00 (16 years ago)

Author:

rblod

Message:

merge solsor and solsor_e, see ticket #45

File:

• trunk/NEMO/OPA_SRC/SOL/solsor.F90 (modified) (8 diffs)

trunk/NEMO/OPA_SRC/SOL/solsor.F90

@@ -43 +43 @@
       !!     as well as islands) while in the latter the boundary condition
       !!     specification is not required.
-      !!
+      !!       This routine provides a MPI optimization to the existing solsor
+      !!     by reducing the number of call to lbc.
+      !! 
       !! ** Method  :   Successive-over-relaxation method using the red-black 
       !!      technique. The former technique used was not compatible with 
       !!      the north-fold boundary condition used in orca configurations.
-      !!
+      !!      Compared to the classical sol_sor, this routine provides a 
+      !!      mpp optimization by reducing the number of calls to lnc_lnk
+      !!      The solution is computed on a larger area and the boudary
+      !!      conditions only when the inside domain is reached.
+      !! 
       !! References :
       !!      Madec et al. 1988, Ocean Modelling, issue 78, 1-6.
+      !!      Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377
       !!
       !! History :
@@ -58 +65 @@
       !!        !  96-11  (A. Weaver)  correction to preconditioning
       !!   9.0  !  03-04  (C. Deltel, G. Madec)  Red-Black SOR in free form
+      !!   9.0  !  05-09  (R. Benshila, G. Madec)  MPI optimization
       !!----------------------------------------------------------------------
       !! * Arguments
@@ -66 +74 @@
       !! * Local declarations
       INTEGER  ::   ji, jj, jn               ! dummy loop indices
-      INTEGER  ::   ishift
+      INTEGER  ::   ishift, icount
       REAL(wp) ::   ztmp, zres, zres2
 
       INTEGER  ::   ijmppodd, ijmppeven
+      INTEGER  ::   ijpr2d
       !!----------------------------------------------------------------------
       
-      ijmppeven = MOD(nimpp+njmpp  ,2)
-      ijmppodd  = MOD(nimpp+njmpp+1,2)
+      ijmppeven = MOD(nimpp+njmpp+jpr2di+jpr2dj,2)
+      ijmppodd  = MOD(nimpp+njmpp+jpr2di+jpr2dj+1,2)
+      ijpr2d = MAX(jpr2di,jpr2dj)
+      icount = 0
       !                                                       ! ==============
       DO jn = 1, nmax                                         ! Iterative loop 
          !                                                    ! ==============
 
-         CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! applied the lateral boundary conditions
-         
+         ! applied the lateral boundary conditions
+         IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   
+        
          ! Residus
          ! -------
 
          ! Guess black update
-         DO jj = 2, jpjm1
-            ishift = MOD( jj-ijmppodd, 2 )
-            DO ji = 2+ishift, jpim1, 2
+         DO jj = 2-jpr2dj, nlcj-1+jpr2dj
+            ishift = MOD( jj-ijmppodd-jpr2dj, 2 )
+            DO ji = 2-jpr2di+ishift, nlci-1+jpr2di, 2
                ztmp =                  gcb(ji  ,jj  )   &
                   &   - gcp(ji,jj,1) * gcx(ji  ,jj-1)   &
@@ -99 +111 @@
             END DO
          END DO
-
-         CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! applied the lateral boubary conditions
+         icount = icount + 1 
+ 
+         ! applied the lateral boundary conditions
+         IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. )  
 
          ! Guess red update
-         DO jj = 2, jpjm1
-            ishift = MOD( jj-ijmppeven, 2 )
-            DO ji = 2+ishift, jpim1, 2
+         DO jj = 2-jpr2dj, nlcj-1+jpr2dj
+            ishift = MOD( jj-ijmppeven-jpr2dj, 2 )
+            DO ji = 2-jpr2di+ishift, nlci-1+jpr2di, 2
                ztmp =                  gcb(ji  ,jj  )   &
                   &   - gcp(ji,jj,1) * gcx(ji  ,jj-1)   &
@@ -118 +132 @@
             END DO
          END DO
+         icount = icount + 1
 
          ! test of convergence
@@ -124 +139 @@
             SELECT CASE ( nsol_arp )
             CASE ( 0 )                 ! absolute precision (maximum value of the residual)
-               zres2 = MAXVAL( gcr(2:jpim1,2:jpjm1) )
+               zres2 = MAXVAL( gcr(2:nlci-1,2:nlcj-1) )
                IF( lk_mpp )   CALL mpp_max( zres2 )   ! max over the global domain
                ! test of convergence
@@ -133 +148 @@
                ENDIF
             CASE ( 1 )                 ! relative precision
-               rnorme = SUM( gcr(2:jpim1,2:jpjm1) )
+               rnorme = SUM( gcr(2:nlci-1,2:nlcj-1) )
                IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain
                ! test of convergence
@@ -163 +178 @@
       !  -------------
 
-      CALL lbc_lnk( gcx, c_solver_pt, 1. )    ! boundary conditions
+      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions