Changeset 2528 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

Timestamp:

2010-12-27T18:33:53+01:00 (13 years ago)

Author:

rblod

Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:

• trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90 (modified) (12 diffs, 1 prop)

trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

@@ -23 +23 @@
 
    USE lib_mpp
+   USE lib_fortran
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   p4z_prod    ! called in p4zbio.F90
+   PUBLIC   p4z_prod         ! called in p4zbio.F90
+   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -41 +43 @@
      grosip    = 0.151_wp
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::        &
-     &                   prmax
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax 
    
    REAL(wp) ::   &
+      rday1                      ,  &  !: 0.6 / rday
       texcret                    ,  &  !: 1 - excret 
       texcret2                   ,  &  !: 1 - excret2        
-      rpis180                    ,  &  !: rpi / 180
       tpp                              !: Total primary production
-
-   INTEGER  ::  nspyr                  !: number of timesteps per year
 
    !!* Substitution
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -78 +77 @@
       REAL(wp) ::   zmxltst, zmxlday, zlim1
       REAL(wp) ::   zpislopen  , zpislope2n
-      REAL(wp) ::   zrum, zcodel, zargu, zvol
-#if defined key_trc_diaadd && defined key_trc_dia3d
+      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol
+#if defined key_diatrc
       REAL(wp) ::   zrfact2
 #endif
@@ -90 +89 @@
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
-
-
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only)
-
 
       zprorca (:,:,:) = 0.0
@@ -109 +104 @@
       ! Computation of the optimal production
 
-# if defined key_off_degrad
-      prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) * facvol(:,:,:)
+# if defined key_degrad
+      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:)
 # else
-      prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:)
+      prmax(:,:,:) = rday1 * tgfunc(:,:,:)
 # endif
 
       ! compute the day length depending on latitude and the day
-      IF(lwp) write(numout,*)
-      IF(lwp) write(numout,*) 'p4zday : - Julian day ', nday_year
-      IF(lwp) write(numout,*) '~~~~~~'
-
-      IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
-         zrum = FLOAT( nday_year - 80 ) / 366.
-      ELSE
-         zrum = FLOAT( nday_year - 80 ) / 365.
-      ENDIF
-      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  )
+      zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp)
+      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  )
 
       ! day length in hours
@@ -131 +118 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 )
+            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
             zargu = MAX( -1., MIN(  1., zargu ) )
-            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. )
+            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+            IF( zval < 1.e0 )   zval = 24.
+            zstrn(ji,jj) = 24. / zval
          END DO
       END DO
@@ -147 +136 @@
                ! Computation of the P-I slope for nanos and diatoms
                IF( etot(ji,jj,jk) > 1.E-3 ) THEN
-                   ztn    = MAX( 0., tn(ji,jj,jk) - 15. )
+                   ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                    zadap  = 0.+ 1.* ztn / ( 2.+ ztn )
                    zadap2 = 0.e0
@@ -227 +216 @@
       END DO
 
-
-      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
-      zstrn(:,:) = 24. / zstrn(:,:)
 
 !CDIR NOVERRCHK
@@ -331 +317 @@
 
      ! Total primary production per year
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj
-          DO ji = 1, jpi
-             zvol = cvol(ji,jj,jk)
-#if defined key_off_degrad
-             zvol = zvol * facvol(ji,jj,jk)
+
+#if defined key_degrad
+     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) )
+#else
+     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 #endif
-             tpp  = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) &
-                          * zvol * tmask(ji,jj,jk) * tmask_i(ji,jj)
-          END DO
-        END DO
-      END DO
-
-
-      IF( MOD( kt, nspyr ) == 0 .AND. jnt == nrdttrc ) THEN
-        IF( lk_mpp ) CALL mpp_sum( tpp )
-        WRITE(numout,*) 'Total PP :'
+
+     IF( kt == nitend .AND. jnt == nrdttrc ) THEN
+        WRITE(numout,*) 'Total PP (Gtc) :'
         WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12
-        WRITE(numout,*) '(GtC/yr)'
-        tpp = 0.
+        WRITE(numout,*) 
       ENDIF
 
-#if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput
+#if defined key_diatrc && ! defined key_iomput
       !   Supplementary diagnostics
       zrfact2 = 1.e3 * rfact2r
@@ -367 +344 @@
 #endif
 
-#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       zrfact2 = 1.e3 * rfact2r
       IF ( jnt == nrdttrc ) then
@@ -396 +373 @@
       !!
       !! ** Method  :   Read the nampisprod namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampisprod
@@ -423 +400 @@
       ENDIF
 
-      ! number of timesteps per year
-      nspyr  = INT( nyear_len(1) * rday / rdt )
-
-      rpis180   = rpi / 180.
+      rday1     = 0.6 / rday 
       texcret   = 1.0 - excret
       texcret2  = 1.0 - excret2