Changeset 31 for trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90

Timestamp:

2004-02-17T10:19:59+01:00 (20 years ago)

Author:

opalod

Message:

CT : BUGFIX012 : Running problem for EEL5 configuration is solved

File:

• trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90 (modified) (8 diffs)

trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90

@@ -36 +36 @@
 
    !! * Shared module variables
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .TRUE.   ! rigid-lid flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .TRUE.    !: rigid-lid flag
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
+#  include "obc_vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LODYC-IPSL  (2003)
@@ -115 +116 @@
          spgu(:,:) = 0.e0      ! surface pressure gradient (i-direction) 
          spgv(:,:) = 0.e0      ! surface pressure gradient (j-direction)
-         bsfb(:,:) = 0.e0      ! before barotropic stream-function
-         bsfn(:,:) = 0.e0      ! now    barotropic stream-function
-         bsfd(:,:) = 0.e0      ! barotropic stream-function trend
       ENDIF
 
@@ -209 +207 @@
          END DO
       END DO
-# if defined key_mpp
-      CALL mpp_sum( rnorme )
-# endif
+      IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain
+
       epsr = eps*eps*rnorme
       ncut = 0
@@ -229 +226 @@
             CALL sol_pcg( kindic )
          CASE( 2 )                     ! successive-over-relaxation
-            CALL sol_sor( kt, kindic )
+            CALL sol_sor( kindic )
          CASE( 3 )                     ! FETI solver
             CALL sol_fet( kindic )
@@ -400 +397 @@
          END DO
       END DO
-#   if defined key_mpp
-      CALL mppobc( bebnd, jpjed, jpjef, jpieob, 3*3, 2, jpj )
-#   endif
+      IF( lk_mpp )   CALL mppobc( bebnd, jpjed, jpjef, jpieob, 3*3, 2, jpj )
       ENDIF
 
@@ -436 +431 @@
          END DO
       END DO
-#   if defined key_mpp
-      CALL mppobc( bwbnd, jpjwd, jpjwf, jpiwob, 3*3, 2, jpj )
-#   endif
+      IF( lk_mpp )   CALL mppobc( bwbnd, jpjwd, jpjwf, jpiwob, 3*3, 2, jpj )
       ENDIF
 
@@ -472 +465 @@
          END DO
       END DO
-#   if defined key_mpp
-      CALL mppobc( bnbnd, jpind, jpinf, jpjnob, 3*3, 1, jpi )
-#   endif
+      IF( lk_mpp )   CALL mppobc( bnbnd, jpind, jpinf, jpjnob, 3*3, 1, jpi )
       ENDIF
 
       IF( lpsouthobc ) THEN
-      ! njsob,(jpsd,jpsf)
-      IF( kt < nit000+3 .AND. .NOT.ln_rstart ) THEN
-         DO ji = nis0m1, nis1
-            ! fields itm2 <== itm
-            bsbnd(ji,ib  ,itm2) = bsbnd(ji,ib  ,itm)
-            bsbnd(ji,ibm ,itm2) = bsbnd(ji,ibm ,itm)
-            bsbnd(ji,ibm2,itm2) = bsbnd(ji,ibm2,itm)
-            bsbnd(ji,ib  ,itm ) = bsbnd(ji,ib  ,it )
-         END DO
-      ELSE
-         DO jj = fs_njs0, fs_njs1   ! vector opt.
+         ! njsob,(jpsd,jpsf)
+         IF( kt < nit000+3 .AND. .NOT.ln_rstart ) THEN
             DO ji = nis0m1, nis1
+               ! fields itm2 <== itm
                bsbnd(ji,ib  ,itm2) = bsbnd(ji,ib  ,itm)
                bsbnd(ji,ibm ,itm2) = bsbnd(ji,ibm ,itm)
                bsbnd(ji,ibm2,itm2) = bsbnd(ji,ibm2,itm)
-               ! fields itm <== it  plus time filter at the boundary
-               bsbnd(jj,ib  ,itm ) = atfp * ( bsbnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bsbnd(jj,ib,it)
-               bsbnd(ji,ibm ,itm ) = bsbnd(ji,ibm ,it )
-               bsbnd(ji,ibm2,itm ) = bsbnd(ji,ibm2,it )
-            END DO
-         END DO
-      ENDIF
-      DO jj = fs_njs0, fs_njs1   ! vector opt.
-         DO ji = nis0m1, nis1 
-            ! fields it <== now (kt+1)
-            bsbnd(ji,ib  ,it  ) = bsfn (ji,jj  )
-            bsbnd(ji,ibm ,it  ) = bsfn (ji,jj+1)
-            bsbnd(ji,ibm2,it  ) = bsfn (ji,jj+2)
-         END DO
-      END DO
-#   if defined key_mpp
-      CALL mppobc( bsbnd, jpisd, jpisf, jpjsob, 3*3, 1, jpi )
-#   endif
+               bsbnd(ji,ib  ,itm ) = bsbnd(ji,ib  ,it )
+            END DO
+         ELSE
+            DO jj = fs_njs0, fs_njs1   ! vector opt.
+               DO ji = nis0m1, nis1
+                  bsbnd(ji,ib  ,itm2) = bsbnd(ji,ib  ,itm)
+                  bsbnd(ji,ibm ,itm2) = bsbnd(ji,ibm ,itm)
+                  bsbnd(ji,ibm2,itm2) = bsbnd(ji,ibm2,itm)
+                  ! fields itm <== it  plus time filter at the boundary
+                  bsbnd(jj,ib  ,itm ) = atfp * ( bsbnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bsbnd(jj,ib,it)
+                  bsbnd(ji,ibm ,itm ) = bsbnd(ji,ibm ,it )
+                  bsbnd(ji,ibm2,itm ) = bsbnd(ji,ibm2,it )
+               END DO
+            END DO
+         ENDIF
+         DO jj = fs_njs0, fs_njs1   ! vector opt.
+            DO ji = nis0m1, nis1 
+               ! fields it <== now (kt+1)
+               bsbnd(ji,ib  ,it  ) = bsfn (ji,jj  )
+               bsbnd(ji,ibm ,it  ) = bsfn (ji,jj+1)
+               bsbnd(ji,ibm2,it  ) = bsfn (ji,jj+2)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc( bsbnd, jpisd, jpisf, jpjsob, 3*3, 1, jpi )
       ENDIF
 # endif
@@ -547 +536 @@
    !!   'key_dynspg_rl'                                        NO rigid lid
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .FALSE.   ! rigid-lid flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .FALSE.   !: rigid-lid flag
 CONTAINS
    SUBROUTINE dyn_spg_rl( kt, kindic )       ! Empty routine
-      WRITE(*,*) kt, kindic
+      WRITE(*,*) 'dyn_spg_rl: You should not have seen this print! error?', kt, kindic
    END SUBROUTINE dyn_spg_rl
 #endif