Changeset 869 for trunk/NEMO/LIM_SRC_3/limitd_me.F90

Timestamp:

2008-03-26T10:21:54+01:00 (16 years ago)

Author:

rblod

Message:

Parallelisation of LIM3. This commit seems to ensure the reproducibility mono/mpp. See ticket #77.

File:

• trunk/NEMO/LIM_SRC_3/limitd_me.F90 (modified) (10 diffs)

trunk/NEMO/LIM_SRC_3/limitd_me.F90

@@ -30 +30 @@
    USE limcons
    USE prtctl           ! Print control
+   USE lib_mpp
  
    IMPLICIT NONE
@@ -187 +188 @@
 
         LOGICAL   ::           &
-           iterate_ridging,    &  ! if true, repeat the ridging
            asum_error              ! flag for asum .ne. 1
+
+        INTEGER :: iterate_ridging ! if true, repeat the ridging
 
         REAL(wp) ::  &         
@@ -282 +284 @@
 !-----------------------------------------------------------------------------!
       niter = 1                 ! iteration counter
-      iterate_ridging = .true.
-
-
-      DO WHILE ( iterate_ridging .AND. niter < nitermax )
+      iterate_ridging = 1
+
+
+      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax )
 
       DO jj = 1, jpj
@@ -349 +351 @@
 ! rates were reduced above), ridge again with new rates.
 
-      iterate_ridging = .false.
+      iterate_ridging = 0
 
       DO jj = 1, jpj
@@ -357 +359 @@
                opning(ji,jj)      = 0.0
             ELSE
-               iterate_ridging    = .true.
+               iterate_ridging    = 1
                divu_adv(ji,jj)    = (1.0 - asum(ji,jj)) / rdt_ice
                closing_net(ji,jj) = MAX(0.0, -divu_adv(ji,jj))
@@ -365 +367 @@
       END DO
 
+      IF( lk_mpp ) CALL mpp_max(iterate_ridging)
+
 ! Repeat if necessary.
 ! NOTE: If strength smoothing is turned on, the ridging must be
@@ -372 +376 @@
       niter = niter + 1
 
-      IF (iterate_ridging) THEN
+      IF (iterate_ridging == 1) THEN
          IF (niter .GT. nitermax) THEN
             WRITE(numout,*) ' ALERTE : non-converging ridging scheme '
@@ -708 +712 @@
          CALL lbc_lnk( strength, 'T', 1. )
 
-         DO jj = 1, jpj - 1
-            DO ji = 1, jpi - 1
+         DO jj = 2, jpj - 1
+            DO ji = 2, jpi - 1
                IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is
                                                                      ! present
@@ -727 +731 @@
          END DO
 
-         DO jj = 1, jpj - 1
-            DO ji = 1, jpi - 1
+         DO jj = 2, jpj - 1
+            DO ji = 2, jpi - 1
                strength(ji,jj) = zworka(ji,jj)
             END DO
          END DO
+         CALL lbc_lnk( strength, 'T', 1. )
 
       ENDIF ! ksmooth
@@ -1760 +1765 @@
       ! Abort model in case of negative area.
       !-----------------------------------------------------------------
-         IF( MAXVAL(a_i(:,:,jl)) .LT. -epsi11 ) THEN
+         IF( MINVAL(a_i(:,:,jl)) .LT. -epsi11 ) THEN
             DO jj = 1, jpj
                DO ji = 1, jpi