Changeset 9817 for branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

Timestamp:

2018-06-21T11:58:42+02:00 (6 years ago)

Author:

dancopsey

Message:

Merged in GO6 package branch up to revision 8356.

File:

• branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (modified) (11 diffs)

branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

@@ -76 +76 @@
       REAL(wp) ::   zchl
       REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
       !!---------------------------------------------------------------------
@@ -83 +84 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr )
       CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
 
@@ -112 +114 @@
       !                                        !  --------------------------------------
       IF( l_trcdm2dc ) THEN                     !  diurnal cycle
-         ! 1% of qsr to compute euphotic layer
-         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr
-         !
-         CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 
+         !
+         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
          !
          DO jk = 1, nksrp      
@@ -123 +125 @@
          END DO
          !
-         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 
          !
          DO jk = 1, nksrp      
@@ -130 +134 @@
          !
       ELSE
-         ! 1% of qsr to compute euphotic layer
-         zqsr100(:,:) = 0.01 * qsr(:,:)
-         !
-         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         !
+         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
          !
          DO jk = 1, nksrp      
@@ -161 +165 @@
          DO jj = 1, jpj
            DO ji = 1, jpi
-              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) )  THEN
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) )  THEN
                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
@@ -226 +230 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr )
       CALL wrk_dealloc( jpi, jpj, jpk, zpar,  ze0, ze1, ze2, ze3 )
       !
@@ -233 +238 @@
    END SUBROUTINE p4z_opt
 
-   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 
+   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
       !!----------------------------------------------------------------------
       !!                  ***  routine p4z_opt_par  ***
@@ -242 +247 @@
       !!----------------------------------------------------------------------
       !! * arguments
-      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
-      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0  
+      INTEGER, INTENT(in)                                        ::  kt            !   ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)               ::  pqsr          !   shortwave
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)            ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL  ::  pe0 
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(out)  , OPTIONAL  ::  pqsr100  
       !! * local variables
       INTEGER    ::   ji, jj, jk     ! dummy loop indices
@@ -255 +261 @@
       ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
       ENDIF
+
+      !  Light at the euphotic depth 
+      IF( PRESENT( pqsr100 ) )  pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
       !
       IF( PRESENT( pe0 ) ) THEN     !  W-level
@@ -439 +448 @@
 
    !!======================================================================
-END MODULE  p4zopt
+END MODULE p4zopt