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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zopt.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals

      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/P2Z/p2zopt.F90

    r12178 r12928  
    3838   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4547CONTAINS 
    4648 
    47    SUBROUTINE p2z_opt( kt ) 
     49   SUBROUTINE p2z_opt( kt, Kmm ) 
    4850      !!--------------------------------------------------------------------- 
    4951      !!                     ***  ROUTINE p2z_opt  *** 
    … …  
    6163      !! 
    6264      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     65      INTEGER, INTENT( in ) ::   Kmm  ! time level index 
    6366      !! 
    6467      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9194      !                                          ! Photosynthetically Available Radiation (PAR) 
    9295      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    93       DO jk = 2, jpk                                  ! local par at w-levels 
    94          DO jj = 1, jpj 
    95             DO ji = 1, jpi 
    96                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  ) 
    97                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    98                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    99                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 
    100                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 
    101             END DO 
    102         END DO 
    103       END DO 
    104       DO jk = 1, jpkm1                                ! mean par at t-levels 
    105          DO jj = 1, jpj 
    106             DO ji = 1, jpi 
    107                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  ) 
    108                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    109                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    110                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 
    111                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 
    112                etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    113             END DO 
    114          END DO 
    115       END DO 
     96      DO_3D_11_11( 2, jpk ) 
     97         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
     98         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     99         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     100         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     101         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
     102      END_3D 
     103      DO_3D_11_11( 1, jpkm1 ) 
     104         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
     105         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     106         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     107         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     108         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
     109         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     110      END_3D 
    116111 
    117112      !                                          ! Euphotic layer 
    118113      !                                          ! -------------- 
    119114      neln(:,:) = 1                                   ! euphotic layer level 
    120       DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom) 
    121          DO jj = 1, jpj 
    122            DO ji = 1, jpi 
    123               IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    124            END DO 
    125          END DO 
    126       END DO 
     115      DO_3D_11_11( 1, jpkm1 ) 
     116        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     117      END_3D 
    127118      !                                               ! Euphotic layer depth 
    128       DO jj = 1, jpj 
    129          DO ji = 1, jpi 
    130             heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 
    131          END DO 
    132       END DO  
     119      DO_2D_11_11 
     120         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
     121      END_2D 
    133122 
    134123 
    135       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     124      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    136125         WRITE(charout, FMT="('opt')") 
    137126         CALL prt_ctl_trc_info( charout ) 
    138          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     127         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    139128      ENDIF 
    140129      ! 
    … …  
    159148      !!---------------------------------------------------------------------- 
    160149 
    161       REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options 
    162150      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901) 
    163151901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' ) 
    164152 
    165       REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options 
    166153      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 ) 
    167154902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' ) 
    … …  
    181168      ENDIF 
    182169      ! 
    183       REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios 
    184170      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903) 
    185171903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' ) 
    186172 
    187       REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios 
    188173      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 ) 
    189174904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.