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 13571 for NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP – NEMO

Ignore:
Timestamp:
2020-10-06T18:17:44+02:00 (4 years ago)
Author:
mocavero
Message:

Align branch with trunk

Location:
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/C14/trcatm_c14.F90

    r13295 r13571  
    120120            IF( ierr3 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 
    121121      ! 
    122             DO_2D( 1, 1, 1, 1 ) 
     122            DO_2D( 1, 1, 1, 1 )                 ! from C14b package 
    123123              IF( gphit(ji,jj) >= yn40 ) THEN 
    124124                 fareaz(ji,jj,1) = 0. 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/CFC/trcsms_cfc.F90

    r13295 r13571  
    126126          
    127127         !                                                         !------------! 
    128          DO_2D( 1, 1, 1, 1 ) 
    129   
     128         DO_2D( 1, 1, 1, 1 )                                       !  i-j loop  ! 
     129            !                                                      !------------! 
    130130            ! space interpolation 
    131131            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P2Z/p2zopt.F90

    r13295 r13571  
    9595      !                                          ! Photosynthetically Available Radiation (PAR) 
    9696      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    97       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     97      DO_3D( 1, 1, 1, 1, 2, jpk )                     ! local par at w-levels 
    9898         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
    9999         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    102102         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
    103103      END_3D 
    104       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     104      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! mean par at t-levels 
    105105         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
    106106         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    114114      !                                          ! -------------- 
    115115      neln(:,:) = 1                                   ! euphotic layer level 
    116       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     116      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! (i.e. 1rst T-level strictly below EL bottom) 
    117117        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    118118      END_3D 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13295 r13571  
    118118         ! 
    119119         zfeequi = zFe3(ji,jj,jk) * 1E-9 
    120          zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    121          fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    122             &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    123             &         + fesol(ji,jj,jk,5) / zhplus ) 
    124120         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    125121         ! precipitation of Fe3+, creation of nanoparticles 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p4zlim.F90

    r13295 r13571  
    161161         zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    162162         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
    163          zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     163         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 
    164164         zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
    165165         zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p4zopt.F90

    r13295 r13571  
    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 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p4zsed.F90

    r13295 r13571  
    313313      ENDIF 
    314314      ! 
    315       IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
     315      IF(sn_cfctl%l_prttrc) THEN  ! print mean trneds (USEd for debugging) 
    316316         WRITE(charout, fmt="('sed ')") 
    317317         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    … …  
    366366      lk_sed = ln_sediment .AND. ln_sed_2way  
    367367      ! 
     368      nitrpot(:,:,jpk) = 0._wp   ! define last level for iom_put 
     369      ! 
    368370   END SUBROUTINE p4z_sed_init 
    369371 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p4zsms.F90

    r13295 r13571  
    6969      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zw2d 
    7070      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zw3d 
    71       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt   ! 4D workspace 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio 
    7272 
    7373      !!--------------------------------------------------------------------- 
    … …  
    9393      rfact = rDt_trc 
    9494      ! 
    95       ! trends computation initialisation 
    96       IF( l_trdtrc )  THEN 
    97          ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter 
    98          ztrdt(:,:,:,:)  = tr(:,:,:,:,Kmm) 
    99       ENDIF 
    100       ! 
    101  
    10295      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 
    10396         rfactr  = 1. / rfact 
    … …  
    117110         END DO 
    118111      ENDIF 
     112 
     113      DO jn = jp_pcs0, jp_pcs1              !   Store the tracer concentrations before entering PISCES 
     114         ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb) 
     115      END DO 
     116 
    119117      ! 
    120118      IF( ll_bc )    CALL p4z_bc( kt, Kbb, Kmm, Krhs )   ! external sources of nutrients  
    … …  
    198196         END DO 
    199197         ! 
    200          IF( ln_top_euler ) THEN 
    201             DO jn = jp_pcs0, jp_pcs1 
    202                tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    203             END DO 
    204          ENDIF 
     198      END DO 
     199      ! 
     200#endif 
     201      ! 
     202      IF( ln_sediment ) THEN  
     203         ! 
     204         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
     205         ! 
     206      ENDIF 
     207      ! 
     208      DO jn = jp_pcs0, jp_pcs1 
     209         tr(:,:,:,jn,Krhs) = ( tr(:,:,:,jn,Kbb) - ztrbbio(:,:,:,jn) ) * rfactr 
     210         tr(:,:,:,jn,Kbb ) = ztrbbio(:,:,:,jn) 
     211         ztrbbio(:,:,:,jn) = 0._wp 
    205212      END DO 
    206213      ! 
    207214      IF( l_trdtrc ) THEN 
    208215         DO jn = jp_pcs0, jp_pcs1 
    209            ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
    210216           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    211217         END DO 
    212          DEALLOCATE( ztrdt )  
    213218      END IF 
    214 #endif 
    215       ! 
    216       IF( ln_sediment ) THEN  
    217          ! 
    218          CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    219          ! 
    220          IF( ln_top_euler ) THEN 
    221             DO jn = jp_pcs0, jp_pcs1 
    222                tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    223             END DO 
    224          ENDIF 
    225          ! 
    226       ENDIF 
    227       ! 
     219      !   
    228220      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
    229221      ! 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P4Z/p5zlim.F90

    r13295 r13571  
    306306         &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   & 
    307307         &          * xqndmax(ji,jj,jk) / (zration + rtrn) 
    308          zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     308         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 
    309309         zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 
    310310         xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/TRP/trcrad.F90

    r13295 r13571  
    168168              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                       ! save input tr(:,:,:,:,Kbb) for trend computation            
    169169              ! 
    170               DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     170              DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    171171                 IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box 
    172172                    ! 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/TRP/trdmxl_trc.F90

    r13295 r13571  
    148148         ! ... Weights for vertical averaging 
    149149         wkx_trc(:,:,:) = 0.e0 
    150          DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 
     150         DO_3D( 1, 1, 1, 1, 1, jpktrd_trc )                       ! initialize wkx_trc with vertical scale factor in mixed-layer 
    151151            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    152152         END_3D 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/oce_trc.F90

    r13286 r13571  
    8585   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
    8686   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
     87   USE traqsr  , ONLY :   nksr       =>    nksr       !: levels below which the light cannot penetrate (depth larger than 391 m) 
     88   USE traqsr  , ONLY :   rkrgb      =>    rkrgb      !: tabulated attenuation coefficients for RGB absorption 
    8789   USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light 
    8890   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/trc.F90

    r12489 r13571  
    2121   INTEGER, PUBLIC ::   numonr     = -1   !: reference passive tracer namelist output output.namelist.top 
    2222   INTEGER, PUBLIC ::   numstr            !: tracer statistics 
    23    INTEGER, PUBLIC ::   numrtr            !: trc restart (read ) 
     23   INTEGER, PUBLIC ::   numrtr     = -1   !: trc restart (read ) 
    2424   INTEGER, PUBLIC ::   numrtw            !: trc restart ( write ) 
    2525   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_ref   !: character buffer for reference passive tracer namelist_top_ref 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/trcbdy.F90

    r13226 r13571  
    4949      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    5050      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    51       REAL(wp), POINTER                 ::  zfac 
    5251      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
    5352      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    … …  
    6160         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
    6261         ELSE                 ;   llrim0 = .FALSE. 
    63          END IF 
     62         ENDIF 
    6463         DO ib_bdy=1, nb_bdy 
     64            ! 
    6565            DO jn = 1, jptra 
    6666               ! 
    67                ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    68                zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     67               IF( ASSOCIATED(trcdta_bdy(jn,ib_bdy)%trc) .AND. trcdta_bdy(jn,ib_bdy)%cn_obc /= 'neumann' ) THEN 
     68                  IF( .NOT. ASSOCIATED(ztrc) )   ALLOCATE( ztrc(idx_bdy(ib_bdy)%nblen(igrd),jpk) ) 
     69                  ztrc(:,:) = trcdta_bdy(jn,ib_bdy)%trc(:,:) * trcdta_bdy(jn,ib_bdy)%rn_fac 
     70               ENDIF 
    6971               ! 
    70                SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     72               SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    7173               CASE('none'        )   ;   CYCLE 
    7274               CASE('frs'         )   ! treat the whole boundary at once 
    73                   IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     75                  IF( ir == 0 )           CALL bdy_frs( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
    7476               CASE('specified'   )   ! treat the whole rim      at once 
    75                   IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
    76                CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked 
    77                CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 
    78                CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 
     77                  IF( ir == 0 )           CALL bdy_spe( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
     78               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd            , tr(:,:,:,jn,Krhs),       llrim0 )   ! tra masked 
     79               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     80                  &                                     ll_npo=.FALSE. ) 
     81               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     82                  &                                     ll_npo=.TRUE.  ) 
    7983               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    8084               END SELECT 
    8185               ! 
    8286            END DO 
     87            ! 
     88            IF( ASSOCIATED(ztrc) )   DEALLOCATE(ztrc) 
     89            ! 
    8390         END DO 
    8491         ! 
    8592         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
    86          IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     93         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   ENDIF 
    8794         DO ib_bdy=1, nb_bdy 
    88             SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     95            SELECT CASE( cn_tra(ib_bdy) ) 
    8996            CASE('neumann') 
    9097               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    … …  
    97104         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    98105            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    99          END IF 
     106         ENDIF 
    100107         ! 
    101108      END DO   ! ir 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/trcdta.F90

    r13295 r13571  
    199199               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    200200            ENDIF 
    201             DO_2D( 1, 1, 1, 1 ) 
     201            DO_2D( 1, 1, 1, 1 )                 ! vertical interpolation of T & S 
    202202               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    203203                  zl = gdept(ji,jj,jk,Kmm) 

  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/trcrst.F90

    r13286 r13571  
    237237               ! calculate start time in hours and minutes 
    238238               zdayfrac=adatrj-INT(adatrj) 
    239                ksecs = NINT(zdayfrac*86400)            ! Nearest second to catch rounding errors in adatrj               
     239               ksecs = NINT(zdayfrac*86400)            ! Nearest second to catch rounding errors in adatrj 
    240240               ihour = INT(ksecs/3600) 
    241241               iminute = ksecs/60-ihour*60 
    … …  
    258258               adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated             
    259259             ELSE 
     260               ndt05 = NINT( 0.5 * rn_Dt  )   !  --- WARNING --- not defined yet are we did not go through day_init 
    260261               ! parameters corresponding to nit000 - 1 (as we start the step 
    261262               ! loop with a call to day) 
    262                ndastp = ndate0 - 1       ! ndate0 read in the namelist in dom_nam 
     263               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam 
    263264               nhour   =   nn_time0 / 100 
    264265               nminute = ( nn_time0 - nhour * 100 ) 
Note: See TracChangeset for help on using the changeset viewer.