Changeset 24 for trunk/NEMO/OPA_SRC

Timestamp:

2004-02-17T09:55:52+01:00 (20 years ago)

Author:

opalod

Message:

CT : BUGFIX007 : Compilation error is solved

File:

• trunk/NEMO/OPA_SRC/DIA/ptr.F90 (modified) (10 diffs)

trunk/NEMO/OPA_SRC/DIA/ptr.F90

@@ -16 +16 @@
    USE oce           ! ocean dynamics and active tracers
    USE dom_oce       ! ocean space and time domain
+   USE ldftra_oce    ! ???
+   USE lib_mpp
+   USE in_out_manager
 
    IMPLICIT NONE
@@ -21 +24 @@
 
    !! *  Routine accessibility
-   PUBLIC dia_ptr    ! call by stp routine
-   PUBLIC prt_vj     ! call by tra_ldf & tra_adv routines
+   PUBLIC dia_ptr_init   ! call in step module
+   PUBLIC dia_ptr        ! call by in step module
+   PUBLIC prt_vj         ! call by tra_ldf & tra_adv routines
 
    !! * Share Module variables
-   LOGICAL, PUBLIC, PARAMETER ::   lk_diaptr = .TRUE.    ! poleward transport flag
-   INTEGER, PUBLIC ::      !!! ** ptr namelist (namptr) **
-      nf_ptr = 15           ! frequency of ptr computation
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaptr = .TRUE.    !: poleward transport flag
+   INTEGER, PUBLIC ::    & !!: ** ptr namelist (namptr) **
+      nf_ptr = 15           !: frequency of ptr computation
    REAL(wp), PUBLIC, DIMENSION(jpj) ::   &   ! poleward transport
-      pht_adv, pst_adv,  &  ! heat and salt: advection
-      pht_ove, pst_ove,  &  ! heat and salt: overturning
-      pht_ldf, pst_ldf,  &  ! heat and salt: lateral diffusion
-      pht_eiv, pst_eiv      ! heat and salt: bolus advection
+      pht_adv, pst_adv,  &  !: heat and salt: advection
+      pht_ove, pst_ove,  &  !: heat and salt: overturning
+      pht_ldf, pst_ldf,  &  !: heat and salt: lateral diffusion
+      pht_eiv, pst_eiv      !: heat and salt: bolus advection
 
    !! Module variables
@@ -45 +49 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LODYC-IPSL  (2003)
@@ -72 +77 @@
       !! * local declarations
       INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER  ::   ijpj = jpj        ! ???
       REAL(wp),DIMENSION(jpj) ::   &
          p_fval                       ! function value
@@ -85 +91 @@
          END DO
       END DO
-
-#if defined key_mpp
-      CALL mpp_sum( p_fval, jpj )     !!bug  I presume
-#endif
+      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume
 
    END FUNCTION ptr_vj
@@ -127 +130 @@
          END DO
       END DO
-
-#if defined key_mpp
-      CALL mpp_sum( p_fval, jpj*jpk )    !!bug  I presume
-#endif
+      IF( lk_mpp)   CALL mpp_sum( p_fval, jpj*jpk )    !!bug  I presume
 
    END FUNCTION ptr_vjk
@@ -171 +171 @@
       END DO
       p_fval(:,:) = p_val(:,:) * 0.5
-
-#if defined key_mpp
-      CALL mpp_sum( p_fval, jpj*jpk )         !!bug  I presume
-#endif
+      IF( lk_mpp )   CALL mpp_sum( p_fval, jpj*jpk )         !!bug  I presume
 
    END FUNCTION ptr_vtjk
@@ -300 +297 @@
                zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
             END DO
-#  if defined key_mpp
-            CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
-#  endif
+            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
+
             !                                        ! =======================
          ELSE                                        !   OTHER configurations
@@ -402 +398 @@
                zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
             END DO
-#  if defined key_mpp
-            CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
-#  endif
+            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
+
             !                                        ! =======================
          ELSE                                        !   OTHER configurations
@@ -515 +510 @@
 CONTAINS
    SUBROUTINE dia_ptr( kt )        ! Empty routine
-      WRITE(*,*) kt
+      WRITE(*,*) 'dia_ptr: You should not have seen this print! error?', kt
    END SUBROUTINE dia_ptr
+   SUBROUTINE dia_ptr_init         ! Empty routine
+      WRITE(*,*) 'dia_ptr_init: You should not have seen this print! error?'
+   END SUBROUTINE dia_ptr_init
 #endif