Changeset 5266 for branches/CNRS/dev_r4826_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

Timestamp:

2015-05-13T10:37:43+02:00 (9 years ago)

Author:

cetlod

Message:

PISCES_QUOTA : First commits, see ticket #1516

File:

• branches/CNRS/dev_r4826_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (modified) (13 diffs)

branches/CNRS/dev_r4826_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

@@ -9 +9 @@
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat
    !!----------------------------------------------------------------------
-#if defined  key_pisces
+#if defined  key_pisces || defined key_pisces_quota
    !!----------------------------------------------------------------------
    !!   'key_pisces'                                       PISCES bio-model
@@ -41 +41 @@
    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for nano and diat 
+#if defined key_pisces_quota
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: epico          !: PAR for pico
+#endif
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer
 
@@ -74 +77 @@
       REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2
+#if defined key_pisces_quota
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp3
+#endif
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3
       !!---------------------------------------------------------------------
@@ -82 +88 @@
       CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
       CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+#if defined key_pisces_quota
+      CALL wrk_alloc( jpi, jpj,      zetmp3 )
+#endif
 
       IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt )
@@ -97 +106 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
+#if defined key_pisces_quota
+               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + trn(ji,jj,jk,jppch) + rtrn ) * 1.e6
+#else
                zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+#endif
                zchl = MIN(  10. , MAX( 0.05, zchl )  )
                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
@@ -132 +145 @@
             enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
             ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
+#if defined key_pisces_quota
+            epico(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
+#endif
          END DO
       END DO
@@ -150 +166 @@
                enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
                ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
+#if defined key_pisces_quota
+               epico(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
+#endif
             END DO
          END DO
       END DO
-
+ 
       IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
          !                                     !  ------------------------
@@ -219 +238 @@
       zetmp1 (:,:)   = 0.e0
       zetmp2 (:,:)   = 0.e0
+#if defined key_pisces_quota
+      zetmp3 (:,:)   = 0.e0
+#endif
 
       DO jk = 1, nksrp
@@ -229 +251 @@
                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk)
                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk)
+#if defined key_pisces_quota
+                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + epico(ji,jj,jk) * fse3t(ji,jj,jk)
+#endif
                   zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
                ENDIF
@@ -247 +272 @@
                   enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep
                   ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+#if defined key_pisces_quota
+                  epico(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+#endif
                ENDIF
             END DO
@@ -268 +296 @@
       CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 )
       CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+#if defined key_pisces_quota
+      CALL wrk_dealloc( jpi, jpj,      zetmp3 )
+#endif
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
@@ -376 +407 @@
                          etot (:,:,:) = 0._wp
                          enano(:,:,:) = 0._wp
+#if defined key_pisces_quota
+                         epico(:,:,:) = 0._wp
+#endif
                          ediat(:,:,:) = 0._wp
       IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp
@@ -388 +422 @@
       !!                     ***  ROUTINE p4z_opt_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
+#if defined key_pisces_quota
+     ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), epico(jpi,jpj,jpk),   &
+      &         STAT=p4z_opt_alloc )
+#else
+      ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk),   &
+      &         STAT=p4z_opt_alloc ) 
+#endif
          !
       IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')