Changeset 184 for trunk/NEMO/OPA_SRC/DIA/diaptr.F90

Timestamp:

2004-11-05T16:33:21+01:00 (19 years ago)

Author:

opalod

Message:

CT : BUGFIX110 : Compilation and execution errors solved

File:

• trunk/NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (11 diffs)

trunk/NEMO/OPA_SRC/DIA/diaptr.F90

@@ -38 +38 @@
    !! * Share Module variables
    LOGICAL, PUBLIC ::   & !!! ** init namelist (namptr) **
-      ln_diaptr = .FALSE.   !: Poleward transport flag (T) or not (F)
+      ln_diaptr = .TRUE.   !: Poleward transport flag (T) or not (F)
    INTEGER, PUBLIC ::   &  !!: ** ptr namelist (namptr) **
       nf_ptr = 15           !: frequency of ptr computation
@@ -165 +165 @@
       !! * local declarations
       INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER, DIMENSION (1) :: ish
+      INTEGER, DIMENSION (2) :: ish2
+      REAL(wp),DIMENSION(jpj*jpk) ::   &
+         zwork                        ! temporary vector for mpp_sum
       REAL(wp),DIMENSION(jpj,jpk) ::   &
          p_fval                       ! return function value
@@ -177 +181 @@
          END DO
       END DO
-      IF( lk_mpp)   CALL mpp_sum( p_fval, jpj*jpk )    !!bug  I presume
+      IF( lk_mpp)   THEN
+          ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk
+          zwork(:)= RESHAPE(p_fval, ish )
+          CALL mpp_sum(zwork, jpj*jpk )
+          p_fval(:,:)= RESHAPE(zwork,ish2)
+      END IF
 
    END FUNCTION ptr_vjk
@@ -202 +211 @@
       !! * local declarations
       INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER, DIMENSION (1) :: ish
+      INTEGER, DIMENSION (2) :: ish2
+      REAL(wp),DIMENSION(jpj*jpk) ::   &
+         zwork                        ! temporary vector for mpp_sum
       REAL(wp),DIMENSION(jpj,jpk) ::   &
          p_fval                       ! return function value
@@ -217 +230 @@
       END DO
       p_fval(:,:) = p_fval(:,:) * 0.5
-      IF( lk_mpp )   CALL mpp_sum( p_fval, jpj*jpk )         !!bug  I presume
+      IF( lk_mpp)   THEN
+          ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk
+          zwork(:)= RESHAPE(p_fval, ish )
+          CALL mpp_sum(zwork, jpj*jpk )
+          p_fval(:,:)= RESHAPE(zwork,ish2)
+      END IF
 
    END FUNCTION ptr_vtjk
@@ -250 +268 @@
       v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) ) 
       ! Bolus "Meridional" Stream-Function
-      DO jk = jpkm1, 1
+      DO jk = jpkm1, 1 , -1
          v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk)
       END DO
@@ -272 +290 @@
 
       ! "Meridional" Stream-Function
-      DO jk = jpkm1, 1
+      DO jk = jpkm1, 1, -1
          v_msf(:,jk) = v_msf(:,jk-1) + v_msf(:,jk)
       END DO
@@ -345 +363 @@
       !! * Arguments
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      REAL(wp), DIMENSION(jpjglo) ::   zphi, zfoo
+      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo
       !!---------------------------------------------------------------------- 
 
@@ -368 +386 @@
             IF( lk_mpp )   CALL mpp_sum( zphi, jpj )        
             ! introduce arbitray northernmost grid point to avoid netcdf error
-            zphi(jpjglo) = 2*zphi(jpjglo-1)-zphi(jpjglo-2)
+            DO jj=mj0(jpjglo), mj1(jpjglo)
+               zphi(jj) = 2*zphi(jj-1)-zphi(jj-2)
+            ENDDO
 
             !                                        ! =======================
@@ -430 +450 @@
          zsto, zout, zdt, zmax, &   ! temporary scalars
          zjulian
-      REAL(wp), DIMENSION(jpjglo) ::   zphi, zfoo
+      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo
       !!----------------------------------------------------------------------
       
@@ -556 +576 @@
          it= kt - nit000 + 1
          ndex(1) = 1
-         WRITE(numout,*)'kt=',kt
          CALL histwrite( numptr, "zotemglo", it, tn_jk    , jpj*jpk, ndex )
-         WRITE(numout,*)'zotemglo OK'
          CALL histwrite( numptr, "zosalglo", it, sn_jk    , jpj*jpk, ndex )
-         WRITE(numout,*)'zosalglo OK'
          CALL histwrite( numptr, "zomsfglo", it, v_msf    , jpj*jpk, ndex )
-         WRITE(numout,*)'zomsfglo OK'
-         WRITE(numout,*)'MAX(pht_adv)=', MAXVAL(pht_adv)
-         WRITE(numout,*)'MIN(pht_adv)=', MINVAL(pht_adv)
          CALL histwrite( numptr, "sophtadv", it, pht_adv  , jpj    , ndex )
-         WRITE(numout,*)'sophtadv OK'
-         WRITE(numout,*)'MAX(pht_ldf)=', MAXVAL(pht_ldf)
-         WRITE(numout,*)'MIN(pht_ldf)=', MINVAL(pht_ldf)
          CALL histwrite( numptr, "sophtldf", it, pht_ldf  , jpj    , ndex )
-         WRITE(numout,*)'sophtldf OK'
-         WRITE(numout,*)'MAX(pht_ove)=', MAXVAL(pht_ove)
-         WRITE(numout,*)'MIN(pht_ove)=', MINVAL(pht_ove)
          CALL histwrite( numptr, "sophtove", it, pht_ove  , jpj    , ndex )
-         WRITE(numout,*)'sophtove OK'
-         WRITE(numout,*)'MAX(pst_adv)=', MAXVAL(pst_adv)
-         WRITE(numout,*)'MIN(pst_adv)=', MINVAL(pst_adv)
          CALL histwrite( numptr, "sopstadv", it, pst_adv  , jpj    , ndex )
-         WRITE(numout,*)'sopstadv OK'
-         WRITE(numout,*)'MAX(pst_ldf)=', MAXVAL(pst_ldf)
-         WRITE(numout,*)'MIN(pst_ldf)=', MINVAL(pst_ldf)
          CALL histwrite( numptr, "sopstldf", it, pst_ldf  , jpj    , ndex )
-         WRITE(numout,*)'sopstldf OK'
-         WRITE(numout,*)'MAX(pst_ove)=', MAXVAL(pst_ove)
-         WRITE(numout,*)'MIN(pst_ove)=', MINVAL(pst_ove)
          CALL histwrite( numptr, "sopstove", it, pst_ove  , jpj    , ndex )
-         WRITE(numout,*)'sopstove OK'
 #if defined key_diaeiv
          CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex )