New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2823 for branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90 – NEMO

Ignore:
Timestamp:
2011-08-09T13:11:24+02:00 (13 years ago)
Author:
cetlod
Message:

Add new parameterisation in PISCES, see ticket #854

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2715 r2823  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
     9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    910   !!---------------------------------------------------------------------- 
    1011#if defined  key_pisces 
     
    1718   USE oce_trc        ! tracer-ocean share variables 
    1819   USE sms_pisces     ! Source Minus Sink of PISCES 
    19    USE iom 
     20   USE iom            ! I/O manager 
    2021 
    2122   IMPLICIT NONE 
     
    5354      !!--------------------------------------------------------------------- 
    5455      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
    56       USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
    57       USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
    58       USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
     56      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp  => wrk_2d_2 
     57      USE wrk_nemo, ONLY:   zetmp1  => wrk_2d_3 , zetmp2 => wrk_2d_4 
     58      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr   => wrk_3d_3 , zekb => wrk_3d_4 
     59      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1    => wrk_3d_6 
     60      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3    => wrk_3d_8 
    5961      ! 
    6062      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     
    6365      INTEGER  ::   irgb 
    6466      REAL(wp) ::   zchl, zxsi0r 
    65       REAL(wp) ::   zc0 , zc1 , zc2, zc3 
     67      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    6668      !!--------------------------------------------------------------------- 
    6769 
    68       IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
     70      IF(  wrk_in_use(2, 1,2,3,4)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
    6971         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
    7072      ENDIF 
     
    8385            DO ji = 1, jpi 
    8486               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    85                zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     87               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    8688               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    8789               !                                                          
     
    9294         END DO 
    9395      END DO 
    94  
    95 !!gm  Potential BUG  must discuss with Olivier about this implementation.... 
    96 !!gm           the questions are : - PAR at T-point or mean PAR over T-level.... 
    97 !!gm                               - shallow water: no penetration of light through the bottom.... 
    9896 
    9997 
     
    145143         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
    146144         ! 
    147          DO jk = 2, nksrp+1 
     145         DO jk = 2, nksrp + 1 
    148146!CDIR NOVERRCHK 
    149147            DO jj = 1, jpj 
     
    188186      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189187      zetmp  (:,:)   = 0.e0 
    190       emoy   (:,:,:) = 0.e0 
     188      zetmp1 (:,:)   = 0.e0 
     189      zetmp2 (:,:)   = 0.e0 
    191190 
    192191      DO jk = 1, nksrp 
     
    196195            DO ji = 1, jpi 
    197196               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    198                   zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 
     197                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
     198                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
     199                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
    199200                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    200201               ENDIF 
     
    210211!CDIR NOVERRCHK 
    211212            DO ji = 1, jpi 
    212                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
     213               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     214                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
     216                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     217                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     218               ENDIF 
    213219            END DO 
    214220         END DO 
     
    218224# if ! defined key_iomput 
    219225      ! save for outputs 
    220       trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     226      trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1) 
    221227      trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    222228# else 
    223229      ! write diagnostics  
    224       IF( jnt == nrdttrc ) then  
     230      IF( jnt == nrdttrc ) then 
    225231         CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    226232         CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     
    229235#endif 
    230236      ! 
    231       IF(  wrk_not_released(2, 1,2)           .OR.   & 
    232            wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     237      IF( wrk_not_released(2, 1,2,3,4)           .OR.   & 
     238          wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
    233239      ! 
    234240   END SUBROUTINE p4z_opt 
Note: See TracChangeset for help on using the changeset viewer.