Ignore:
Timestamp:
2020-07-01T16:09:00+02:00 (3 months ago)
Author:
gsamson
Message:

merge with trunk@r13136 with a more recent svn version; pass all SETTE tests; results identical to trunk@r13136; ticket #2419

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/trazdf.F90

    r12489 r13197  
    3535   PUBLIC   tra_zdf_imp   ! called by trczdf.F90 
    3636 
     37   !! * Substitutions 
     38#  include "do_loop_substitute.h90" 
    3739   !!---------------------------------------------------------------------- 
    3840   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7779      ! JMM avoid negative salinities near river outlet ! Ugly fix 
    7880      ! JMM : restore negative salinities to small salinities: 
    79 !!$   WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp 
     81!!$      WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp )   pts(:,:,:,jp_sal,Kaa) = 0.1_wp 
    8082!!gm 
    8183 
     
    9597      ENDIF 
    9698      !                                          ! print mean trends (used for debugging) 
    97       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    98          &                       tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     99      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
     100         &                                  tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    99101      ! 
    100102      IF( ln_timing )   CALL timing_stop('tra_zdf') 
     
    154156            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    155157               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
    156                   DO jk = 2, jpkm1 
    157                      DO jj = 2, jpjm1 
    158                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    159                            zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
    160                         END DO 
    161                      END DO 
    162                   END DO 
     158                  DO_3D_00_00( 2, jpkm1 ) 
     159                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
     160                  END_3D 
    163161               ELSE                          ! standard or triad iso-neutral operator 
    164                   DO jk = 2, jpkm1 
    165                      DO jj = 2, jpjm1 
    166                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    167                            zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
    168                         END DO 
    169                      END DO 
    170                   END DO 
     162                  DO_3D_00_00( 2, jpkm1 ) 
     163                     zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
     164                  END_3D 
    171165               ENDIF 
    172166            ENDIF 
     
    174168            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    175169            IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection 
    176                DO jk = 1, jpkm1 
    177                   DO jj = 2, jpjm1 
    178                      DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.) 
    179                         zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm) 
    180                         zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    181                         zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   & 
    182                            &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 
    183                         zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp ) 
    184                         zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp ) 
    185                     END DO 
    186                   END DO 
    187                END DO 
     170               DO_3D_00_00( 1, jpkm1 ) 
     171                  zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk  ,Kmm) 
     172                  zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     173                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws   & 
     174                     &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 
     175                  zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp ) 
     176                  zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp ) 
     177               END_3D 
    188178            ELSE 
    189                DO jk = 1, jpkm1 
    190                   DO jj = 2, jpjm1 
    191                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    192                         zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm) 
    193                         zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
    194                         zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    195                     END DO 
    196                   END DO 
    197                END DO 
     179               DO_3D_00_00( 1, jpkm1 ) 
     180                  zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w(ji,jj,jk,Kmm) 
     181                  zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     182                  zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     183               END_3D 
    198184            ENDIF 
    199185            ! 
     
    217203            !   used as a work space array: its value is modified. 
    218204            ! 
    219             DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    220                DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction) 
    221                   zwt(ji,jj,1) = zwd(ji,jj,1) 
    222                END DO 
    223             END DO 
    224             DO jk = 2, jpkm1 
    225                DO jj = 2, jpjm1 
    226                   DO ji = fs_2, fs_jpim1 
    227                      zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 
    228                   END DO 
    229                END DO 
    230             END DO 
     205            DO_2D_00_00 
     206               zwt(ji,jj,1) = zwd(ji,jj,1) 
     207            END_2D 
     208            DO_3D_00_00( 2, jpkm1 ) 
     209               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 
     210            END_3D 
    231211            ! 
    232212         ENDIF  
    233213         !          
    234          DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    235             DO ji = fs_2, fs_jpim1 
    236                pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
    237             END DO 
    238          END DO 
    239          DO jk = 2, jpkm1 
    240             DO jj = 2, jpjm1 
    241                DO ji = fs_2, fs_jpim1 
    242                   zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side 
    243                   pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 
    244                END DO 
    245             END DO 
    246          END DO 
     214         DO_2D_00_00 
     215            pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 
     216         END_2D 
     217         DO_3D_00_00( 2, jpkm1 ) 
     218            zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs)   ! zrhs=right hand side 
     219            pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 
     220         END_3D 
    247221         ! 
    248          DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    249             DO ji = fs_2, fs_jpim1 
    250                pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
    251             END DO 
    252          END DO 
    253          DO jk = jpk-2, 1, -1 
    254             DO jj = 2, jpjm1 
    255                DO ji = fs_2, fs_jpim1 
    256                   pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   & 
    257                      &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
    258                END DO 
    259             END DO 
    260          END DO 
     222         DO_2D_00_00 
     223            pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
     224         END_2D 
     225         DO_3DS_00_00( jpk-2, 1, -1 ) 
     226            pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) )   & 
     227               &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
     228         END_3D 
    261229         !                                            ! ================= ! 
    262230      END DO                                          !  end tracer loop  ! 
Note: See TracChangeset for help on using the changeset viewer.