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 12377 for NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90

    r12276 r12377  
    4242   REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4343    
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4951CONTAINS 
    5052 
    51    SUBROUTINE p4z_opt( kt, knt ) 
     53   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 
    5254      !!--------------------------------------------------------------------- 
    5355      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5961      !!--------------------------------------------------------------------- 
    6062      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     63      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    6164      ! 
    6265      INTEGER  ::   ji, jj, jk 
    … …  
    8285      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    8386      !                                        !  -------------------------------------------------------- 
    84                      zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    85       IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch) 
    86       ! 
    87       DO jk = 1, jpkm1    
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90                zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
    91                zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    92                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    93                !                                                          
    94                ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 
    95                ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
    96                ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
    97             END DO 
    98          END DO 
    99       END DO 
     87                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 
     88      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
     89      ! 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
     92         zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
     93         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     94         !                                                          
     95         ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     96         ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     97         ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
     98      END_3D 
    10099      !                                        !* Photosynthetically Available Radiation (PAR) 
    101100      !                                        !  -------------------------------------- 
    … …  
    104103         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    105104         ! 
    106          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
     105         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    107106         ! 
    108107         DO jk = 1, nksrp       
    … …  
    119118         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    120119         ! 
    121          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
     120         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )  
    122121         ! 
    123122         DO jk = 1, nksrp       
    … …  
    129128         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    130129         ! 
    131          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
     130         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    132131         ! 
    133132         DO jk = 1, nksrp       
    134             etot (:,:,jk) =         ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
     133            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    135134            enano(:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
    136135            ediat(:,:,jk) =  1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk) 
    … …  
    147146      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    148147         !                                     !  ------------------------ 
    149          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
     148         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    150149         ! 
    151150         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    … …  
    157156      !                                        !* Euphotic depth and level 
    158157      neln   (:,:) = 1                            !  ------------------------ 
    159       heup   (:,:) = gdepw_n(:,:,2) 
    160       heup_01(:,:) = gdepw_n(:,:,2) 
    161  
    162       DO jk = 2, nksrp 
    163          DO jj = 1, jpj 
    164            DO ji = 1, jpi 
    165               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    166                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    167                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    168                  heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    169               ENDIF 
    170               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
    171                  heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
    172               ENDIF 
    173            END DO 
    174         END DO 
    175       END DO 
     158      heup   (:,:) = gdepw(:,:,2,Kmm) 
     159      heup_01(:,:) = gdepw(:,:,2,Kmm) 
     160 
     161      DO_3D_11_11( 2, nksrp ) 
     162        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
     163           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     164           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     165           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth 
     166        ENDIF 
     167        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     168           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
     169        ENDIF 
     170      END_3D 
    176171      ! 
    177172      heup   (:,:) = MIN( 300., heup   (:,:) ) 
    … …  
    182177      zetmp2 (:,:)   = 0.e0 
    183178 
    184       DO jk = 1, nksrp 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    188                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
    189                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    190                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    191                ENDIF 
    192             END DO 
    193          END DO 
    194       END DO 
     179      DO_3D_11_11( 1, nksrp ) 
     180         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     181            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     182            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     183            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     184         ENDIF 
     185      END_3D 
    195186      ! 
    196187      emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
    197188      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    198189      ! 
    199       DO jk = 1, nksrp 
    200          DO jj = 1, jpj 
    201             DO ji = 1, jpi 
    202                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    203                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    204                   emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    205                   zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
    206                ENDIF 
    207             END DO 
    208          END DO 
    209       END DO 
     190      DO_3D_11_11( 1, nksrp ) 
     191         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     192            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     193            emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     194            zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     195         ENDIF 
     196      END_3D 
    210197      ! 
    211198      zdepmoy(:,:)   = 0.e0 
    … …  
    213200      zetmp4 (:,:)   = 0.e0 
    214201      ! 
    215       DO jk = 1, nksrp 
    216          DO jj = 1, jpj 
    217             DO ji = 1, jpi 
    218                IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    219                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    220                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    221                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    222                ENDIF 
    223             END DO 
    224          END DO 
    225       END DO 
     202      DO_3D_11_11( 1, nksrp ) 
     203         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     204            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     205            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     206            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     207         ENDIF 
     208      END_3D 
    226209      enanom(:,:,:) = enano(:,:,:) 
    227210      ediatm(:,:,:) = ediat(:,:,:) 
    228211      ! 
    229       DO jk = 1, nksrp 
    230          DO jj = 1, jpj 
    231             DO ji = 1, jpi 
    232                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    233                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    234                   enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
    235                   ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
    236                ENDIF 
    237             END DO 
    238          END DO 
    239       END DO 
     212      DO_3D_11_11( 1, nksrp ) 
     213         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     214            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
     216            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
     217         ENDIF 
     218      END_3D 
    240219      ! 
    241220      IF( ln_p5z ) THEN 
    242221         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
    243          DO jk = 1, nksrp 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    247                      zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    248                   ENDIF 
    249                END DO 
    250             END DO 
    251          END DO 
     222         DO_3D_11_11( 1, nksrp ) 
     223            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     224               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     225            ENDIF 
     226         END_3D 
    252227         ! 
    253228         epicom(:,:,:) = epico(:,:,:) 
    254229         ! 
    255          DO jk = 1, nksrp 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    259                      z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    260                      epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
    261                   ENDIF 
    262                END DO 
    263             END DO 
    264          END DO 
     230         DO_3D_11_11( 1, nksrp ) 
     231            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     232               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     233               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     234            ENDIF 
     235         END_3D 
    265236         DEALLOCATE( zetmp5 ) 
    266237      ENDIF 
    … …  
    277248 
    278249 
    279    SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
     250   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
    280251      !!---------------------------------------------------------------------- 
    281252      !!                  ***  routine p4z_opt_par  *** 
    … …  
    286257      !!---------------------------------------------------------------------- 
    287258      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step 
     259      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index 
    288260      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave 
    289261      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B) 
    … …  
    313285            DO jj = 1, jpj 
    314286               DO ji = 1, jpi 
    315                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
     287                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
    316288                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    317289                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
    … …  
    329301        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    330302        ! 
    331         DO jk = 2, nksrp       
    332            DO jj = 1, jpj 
    333               DO ji = 1, jpi 
    334                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    335                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
    336                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
    337               END DO 
    338            END DO 
    339         END DO     
     303        DO_3D_11_11( 2, nksrp ) 
     304           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
     305           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     306           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
     307        END_3D 
    340308        ! 
    341309      ENDIF 
    … …  
    398366         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    399367      ENDIF 
    400  
    401       REWIND( numnatp_ref ) 
    402368      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 
    403369901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist' ) 
    404  
    405       REWIND( numnatp_cfg ) 
    406370      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 
    407371902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.