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

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

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

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

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

    r10068 r13463  
    1818   USE trc 
    1919   USE sms_pisces 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    3838   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4043   !!---------------------------------------------------------------------- 
    4144   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4548CONTAINS 
    4649 
    47    SUBROUTINE p2z_opt( kt ) 
     50   SUBROUTINE p2z_opt( kt, Kmm ) 
    4851      !!--------------------------------------------------------------------- 
    4952      !!                     ***  ROUTINE p2z_opt  *** 
    … …  
    6164      !! 
    6265      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     66      INTEGER, INTENT( in ) ::   Kmm  ! time level index 
    6367      !! 
    6468      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9195      !                                          ! Photosynthetically Available Radiation (PAR) 
    9296      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 
     97      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     98         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
     99         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     100         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     101         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     102         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
     103      END_3D 
     104      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     105         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
     106         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     107         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     108         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     109         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
     110         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     111      END_3D 
    116112 
    117113      !                                          ! Euphotic layer 
    118114      !                                          ! -------------- 
    119115      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 
     116      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     117        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     118      END_3D 
    127119      !                                               ! 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  
     120      DO_2D( 1, 1, 1, 1 ) 
     121         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
     122      END_2D 
    133123 
    134124 
    135       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     125      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    136126         WRITE(charout, FMT="('opt')") 
    137          CALL prt_ctl_trc_info( charout ) 
    138          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     127         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     128         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    139129      ENDIF 
    140130      ! 
    … …  
    159149      !!---------------------------------------------------------------------- 
    160150 
    161       REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options 
    162151      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901) 
    163 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist', lwp ) 
     152901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' ) 
    164153 
    165       REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options 
    166154      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 ) 
    167 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist', lwp ) 
     155902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' ) 
    168156      IF(lwm) WRITE ( numonp, namlobopt ) 
    169157 
    … …  
    181169      ENDIF 
    182170      ! 
    183       REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios 
    184171      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903) 
    185 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist', lwp ) 
     172903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' ) 
    186173 
    187       REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios 
    188174      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 ) 
    189 904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist', lwp ) 
     175904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' ) 
    190176      IF(lwm) WRITE ( numonp, namlobrat ) 
    191177 
Note: See TracChangeset for help on using the changeset viewer.