Ignore:
Timestamp:
2020-07-22T16:05:31+02:00 (4 months ago)
Author:
cetlod
Message:

trunk : bugfix in the heat content trend when activating bio-model light penetration, see ticket #2499

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90

    r13295 r13333  
    3737   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   par_varsw      ! PAR fraction of shortwave 
    3838   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ekb, ekg, ekr  ! wavelength (Red-Green-Blue) 
    39  
    40    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    41  
    42    REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4339    
    4440   !! * Substitutions 
     
    9490         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    9591         !                                                          
    96          ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
    97          ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
    98          ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
     92         ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     93         ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     94         ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
    9995      END_3D 
    10096      !                                        !* Photosynthetically Available Radiation (PAR) 
     
    106102         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    107103         ! 
    108          DO jk = 1, nksrp       
     104         DO jk = 1, nksr       
    109105            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    110106            enano    (:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
     
    112108         END DO 
    113109         IF( ln_p5z ) THEN 
    114             DO jk = 1, nksrp       
     110            DO jk = 1, nksr       
    115111              epico  (:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    116112            END DO 
     
    121117         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )  
    122118         ! 
    123          DO jk = 1, nksrp       
     119         DO jk = 1, nksr       
    124120            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 
    125121         END DO 
     
    131127         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    132128         ! 
    133          DO jk = 1, nksrp       
     129         DO jk = 1, nksr       
    134130            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    135131            enano(:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
     
    137133         END DO 
    138134         IF( ln_p5z ) THEN 
    139             DO jk = 1, nksrp       
     135            DO jk = 1, nksr       
    140136              epico(:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    141137            END DO 
     
    150146         ! 
    151147         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    152          DO jk = 2, nksrp + 1 
     148         DO jk = 2, nksr + 1 
    153149            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 
    154150         END DO 
     
    160156      heup_01(:,:) = gdepw(:,:,2,Kmm) 
    161157 
    162       DO_3D( 1, 1, 1, 1, 2, nksrp ) 
     158      DO_3D( 1, 1, 1, 1, 2, nksr ) 
    163159        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    164160           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     
    178174      zetmp2 (:,:)   = 0.e0 
    179175 
    180       DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     176      DO_3D( 1, 1, 1, 1, 1, nksr ) 
    181177         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    182178            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     
    189185      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    190186      ! 
    191       DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     187      DO_3D( 1, 1, 1, 1, 1, nksr ) 
    192188         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    193189            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     
    201197      zetmp4 (:,:)   = 0.e0 
    202198      ! 
    203       DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     199      DO_3D( 1, 1, 1, 1, 1, nksr ) 
    204200         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    205201            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     
    211207      ediatm(:,:,:) = ediat(:,:,:) 
    212208      ! 
    213       DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     209      DO_3D( 1, 1, 1, 1, 1, nksr ) 
    214210         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    215211            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     
    221217      IF( ln_p5z ) THEN 
    222218         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
    223          DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     219         DO_3D( 1, 1, 1, 1, 1, nksr ) 
    224220            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    225221               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     
    229225         epicom(:,:,:) = epico(:,:,:) 
    230226         ! 
    231          DO_3D( 1, 1, 1, 1, 1, nksrp ) 
     227         DO_3D( 1, 1, 1, 1, 1, nksr ) 
    232228            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    233229               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     
    283279         pe3(:,:,1) = zqsr(:,:) 
    284280         ! 
    285          DO jk = 2, nksrp + 1 
     281         DO jk = 2, nksr + 1 
    286282            DO jj = 1, jpj 
    287283               DO ji = 1, jpi 
     
    302298        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    303299        ! 
    304         DO_3D( 1, 1, 1, 1, 2, nksrp ) 
     300        DO_3D( 1, 1, 1, 1, 2, nksr ) 
    305301           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    306302           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     
    400396         ntimes_par = iom_getszuld( numpar )   ! get number of record in file 
    401397      ENDIF 
    402       ! 
    403       CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    404       nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp )     ! max level of light extinction (Blue Chl=0.01) 
    405       ! 
    406       IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 
    407398      ! 
    408399                         ekr      (:,:,:) = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.