Changeset 312 for trunk/NEMO/OPA_SRC/SOL/solmat.F90

Timestamp:

2005-09-30T12:20:54+02:00 (19 years ago)

Author:

opalod

Message:

nemo_v1_update_017:RB: added a new solver (nsolv=4) corresponding to solsor with extra outer halo.

File:

• trunk/NEMO/OPA_SRC/SOL/solmat.F90 (modified) (3 diffs)

trunk/NEMO/OPA_SRC/SOL/solmat.F90

@@ -17 +17 @@
    USE phycst          ! physical constants
    USE obc_oce         ! ocean open boundary conditions
+   USE lbclnk          ! lateral boudary conditions
    USE lib_mpp         ! distributed memory computing
    USE dynspg_rl
@@ -232 +233 @@
          gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:)
          gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:)
-         IF( nsolv == 2 )   gccd(:,:) = sor * gcp(:,:,2)
+         IF( ( nsolv == 2 ) .OR. ( nsolv == 2 ) )  gccd(:,:) = sor * gcp(:,:,2)
+
+         IF( nsolv == 4 ) THEN
+            CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1. )   ! lateral boundary conditions
+            CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1. )   ! lateral boundary conditions
+            CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1. )   ! lateral boundary conditions
+            CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1. )   ! lateral boundary conditions
+            CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions
+            CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions         
+            IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements
+         END IF
 
       ELSE
@@ -308 +319 @@
       
    END SUBROUTINE sol_mat
+
+
+   SUBROUTINE sol_exd( pt3d, cd_type )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine sol_exd  ***
+      !!                  
+      !! ** Purpose :   Reorder gcb coefficient on the extra outer  halo 
+      !!                at north fold in case of T or F pivot
+      !!
+      !! ** Method  :   Perform a circular permutation of the coefficients on 
+      !!                the total area strictly above the pivot point,
+      !!                and on the semi-row of the pivot point   
+      !!                
+      !! History :
+      !!   9.0  !  05-09  (R. Benshila)  original routine
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of pt2d array grid-points
+         !             !  = T , U , V , F , W 
+         !             !  = S : T-point, north fold treatment
+         !             !  = G : F-point, north fold treatment
+         !             !  = I : sea-ice velocity at F-point with index shift
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), INTENT( inout ) ::   &
+         pt3d          ! 2D array on which the boundary condition is applied
+
+      !! * Local variables
+      INTEGER  ::   ji, jk      ! dummy loop indices
+      INTEGER  ::   iloc                ! temporary integers
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   &
+         ztab          ! 2D array on which the boundary condition is applied
+      !!----------------------------------------------------------------------
+
+      ztab = pt3d
+
+      ! north fold treatment
+      ! -----------------------
+  
+      SELECT CASE ( npolj )
+         
+         CASE ( 3 , 4 )   !  T pivot
+         iloc = jpiglo/2 +1 
+            
+            SELECT CASE ( cd_type )
+  
+            CASE ( 'T', 'S', 'U', 'W' )
+               DO jk =1, 4
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+                  ENDDO
+               ENDDO
+
+              DO jk =1, 4
+                  DO ji = nlci+jpr2di, 1-jpr2di,  -1
+                     IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) &
+                       & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT
+                     pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4))
+                  ENDDO
+               ENDDO
+
+            CASE ( 'F' ,'G' , 'I', 'V' )
+               DO jk =1, 4
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     pt3d(ji,nlcj-1:nlcj+jpr2dj,jk) = ztab(ji,nlcj-1:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+                  ENDDO
+               ENDDO
+
+            END SELECT   ! cd_type
+  
+         CASE ( 5 , 6 )                 ! F pivot
+          iloc=jpiglo/2
+
+            SELECT CASE (cd_type )
+
+            CASE ( 'T'  ,'S', 'U', 'W')
+               DO jk =1, 4
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+                  ENDDO
+               ENDDO
+
+            CASE ( 'F' ,'G' , 'I', 'V' )
+               DO jk =1, 4
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+                  ENDDO
+               ENDDO
+               DO jk =1, 4
+                  DO ji = nlci+jpr2di, 1-jpr2di,  -1
+                    IF ( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) &
+                       & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT
+                    pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4))
+                  ENDDO
+               ENDDO
+
+            END SELECT   ! cd_type
+
+         END SELECT   ! npolj
+  
+   END SUBROUTINE sol_exd
 
 #if defined key_feti