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 14801 – NEMO

Changeset 14801


Ignore:
Timestamp:
2021-05-06T18:36:42+02:00 (16 months ago)
Author:
francesca
Message:

add loop fusion to DYN and TRA modules - ticket #2607

Location:
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src
Files:
5 added
1 deleted
11 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_iso.F90

    r14757 r14801  
    2828   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2929   USE prtctl          ! Print control 
     30#if defined key_loop_fusion 
     31   USE dynldf_iso_lf   ! lateral mixing - loop fusion version (dyn_ldf_iso routine ) 
     32#endif 
    3033 
    3134   IMPLICIT NONE 
     
    116119      !!---------------------------------------------------------------------- 
    117120      ! 
     121#if defined key_loop_fusion 
     122      CALL dyn_ldf_iso_lf( kt, Kbb, Kmm, puu, pvv, Krhs    )  
     123#else 
     124 
    118125      IF( kt == nit000 ) THEN 
    119126         IF(lwp) WRITE(numout,*) 
     
    395402      END DO                                           !   End of slab 
    396403      !                                                ! =============== 
     404#endif 
    397405   END SUBROUTINE dyn_ldf_iso 
    398406 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_lap_blp.F90

    r14757 r14801  
    2121   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2222   USE lib_mpp 
     23#if defined key_loop_fusion 
     24   USE dynldf_lap_blp_lf 
     25#endif 
    2326    
    2427   IMPLICIT NONE 
     
    6568      !!---------------------------------------------------------------------- 
    6669      ! 
     70#if defined key_loop_fusion 
     71      CALL dyn_ldf_lap_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )  
     72#else 
    6773      IF( kt == nit000 .AND. lwp ) THEN 
    6874         WRITE(numout,*) 
     
    150156      END SELECT 
    151157      ! 
     158#endif 
    152159   END SUBROUTINE dyn_ldf_lap 
    153160 
     
    174181      !!---------------------------------------------------------------------- 
    175182      ! 
     183#if defined key_loop_fusion 
     184      CALL dyn_ldf_blp_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs )  
     185#else 
    176186      IF( kt == nit000 )  THEN 
    177187         IF(lwp) WRITE(numout,*) 
     
    189199      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
    190200      ! 
     201#endif 
    191202   END SUBROUTINE dyn_ldf_blp 
    192203 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynvor.F90

    r14757 r14801  
    609609      REAL(wp) ::   zua, zva     ! local scalars 
    610610      REAL(wp) ::   zmsk, ze3f   ! local scalars 
    611       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy , z1_e3f 
     611      REAL(wp), DIMENSION(jpi,jpj)       ::   z1_e3f 
     612#if defined key_loop_fusion 
     613      REAL(wp) ::   ztne, ztnw, ztnw_ip1, ztse, ztse_jp1, ztsw_jp1, ztsw_ip1 
     614      REAL(wp) ::   zwx, zwx_im1, zwx_jp1, zwx_im1_jp1 
     615      REAL(wp) ::   zwy, zwy_ip1, zwy_jm1, zwy_ip1_jm1  
     616#else 
     617      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy  
    612618      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
     619#endif 
    613620      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    614621      !!---------------------------------------------------------------------- 
     
    706713      ! 
    707714      !                                                ! =============== 
    708       DO jk = 1, jpkm1                                 ! Horizontal slab 
    709          !                                             ! =============== 
     715      !                                                ! Horizontal slab 
     716      !                                                ! =============== 
     717#if defined key_loop_fusion 
     718      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     719         !                                   !==  horizontal fluxes  ==! 
     720         zwx         = e2u(ji  ,jj  ) * e3u(ji  ,jj  ,jk,Kmm) * pu(ji  ,jj  ,jk) 
     721         zwx_im1     = e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * pu(ji-1,jj  ,jk) 
     722         zwx_jp1     = e2u(ji  ,jj+1) * e3u(ji  ,jj+1,jk,Kmm) * pu(ji  ,jj+1,jk) 
     723         zwx_im1_jp1 = e2u(ji-1,jj+1) * e3u(ji-1,jj+1,jk,Kmm) * pu(ji-1,jj+1,jk) 
     724         zwy         = e1v(ji  ,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * pv(ji  ,jj  ,jk) 
     725         zwy_ip1     = e1v(ji+1,jj  ) * e3v(ji+1,jj  ,jk,Kmm) * pv(ji+1,jj  ,jk) 
     726         zwy_jm1     = e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * pv(ji  ,jj-1,jk) 
     727         zwy_ip1_jm1 = e1v(ji+1,jj-1) * e3v(ji+1,jj-1,jk,Kmm) * pv(ji+1,jj-1,jk) 
     728         !                                   !==  compute and add the vorticity term trend  =! 
     729         ztne     = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     730         ztnw     = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     731         ztnw_ip1 = zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji+1,jj  ,jk) 
     732         ztse     = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     733         ztse_jp1 = zwz(ji  ,jj+1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) 
     734         ztsw_jp1 = zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) + zwz(ji-1,jj+1,jk) 
     735         ztsw_ip1 = zwz(ji+1,jj-1,jk) + zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) 
     736         ! 
     737         zua = + r1_12 * r1_e1u(ji,jj) * (  ztne * zwy + ztnw_ip1 * zwy_ip1   & 
     738            &                             + ztse * zwy_jm1 + ztsw_ip1 * zwy_ip1_jm1 ) 
     739         zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw_jp1 * zwx_im1_jp1 + ztse_jp1 * zwx_jp1   & 
     740            &                             + ztnw * zwx_im1 + ztne * zwx ) 
     741         pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua 
     742         pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
     743      END_3D 
     744#else 
     745      DO jk = 1, jpkm1       
    710746         ! 
    711747         !                                   !==  horizontal fluxes  ==! 
     
    729765            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
    730766         END_2D 
    731          !                                             ! =============== 
    732       END DO                                           !   End of slab 
     767      END DO 
     768#endif 
     769         !                                             ! =============== 
     770         !                                             !   End of slab 
    733771      !                                                ! =============== 
    734772   END SUBROUTINE vor_een 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynzdf.F90

    r13497 r14801  
    1919   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    2020   USE dynadv    ,ONLY: ln_dynadv_vec    ! dynamics: advection form 
     21#if defined key_loop_fusion 
     22   USE dynldf_iso_lf,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing  
     23#else 
    2124   USE dynldf_iso,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing  
     25#endif 
    2226   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. and type of operator 
    2327   USE trd_oce        ! trends: ocean variables 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv.F90

    r14757 r14801  
    2525   USE traadv_cen     ! centered scheme            (tra_adv_cen  routine) 
    2626   USE traadv_fct     ! FCT      scheme            (tra_adv_fct  routine) 
    27    USE traadv_fct_lf  ! FCT      scheme            (tra_adv_fct  routine - loop fusion version) 
    2827   USE traadv_mus     ! MUSCL    scheme            (tra_adv_mus  routine) 
    29    USE traadv_mus_lf  ! MUSCL    scheme            (tra_adv_mus  routine - loop fusion version) 
    3028   USE traadv_ubs     ! UBS      scheme            (tra_adv_ubs  routine) 
    3129   USE traadv_qck     ! QUICKEST scheme            (tra_adv_qck  routine) 
     
    180178            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    181179         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    182             IF (nn_hls==2) THEN 
    183 #if defined key_loop_fusion 
    184                CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    185 #else 
    186180               CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    187 #endif 
    188             ELSE 
    189                CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    190             END IF 
    191181         CASE ( np_MUS )                                 ! MUSCL 
    192             IF (nn_hls==2) THEN 
    193 #if defined key_loop_fusion 
    194                 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    195 #else 
    196182                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    197 #endif 
    198             ELSE 
    199                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    200             END IF 
    201183         CASE ( np_UBS )                                 ! UBS 
    202184            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_cen.F90

    r14776 r14801  
    2323   USE trc_oce        ! share passive tracers/Ocean variables 
    2424   USE lib_mpp        ! MPP library 
     25#if defined key_loop_fusion 
     26   USE traadv_cen_lf  ! centered scheme            (tra_adv_cen  routine - loop fusion version) 
     27#endif 
    2528 
    2629   IMPLICIT NONE 
     
    8285      !!---------------------------------------------------------------------- 
    8386      ! 
     87#if defined key_loop_fusion 
     88      CALL tra_adv_cen_lf    ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v ) 
     89#else 
    8490      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    8591         IF( kt == kit000 )  THEN 
     
    184190      END DO 
    185191      ! 
     192#endif 
    186193   END SUBROUTINE tra_adv_cen 
    187194 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_fct.F90

    r14776 r14801  
    3434   PUBLIC   tra_adv_fct        ! called by traadv.F90 
    3535   PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90 
    36    PUBLIC   tridia_solver      ! called by traadv_fct_lf.F90 
    37    PUBLIC   nonosc             ! called by traadv_fct_lf.F90 - key_agrif 
    3836 
    3937   LOGICAL  ::   l_trd   ! flag to compute trends 
     
    9593      !!---------------------------------------------------------------------- 
    9694      ! 
     95#if defined key_loop_fusion 
     96      CALL tra_adv_fct_lf ( kt, nit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 
     97#else 
    9798      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9899         IF( kt == kit000 )  THEN 
     
    380381      ENDIF 
    381382      ! 
     383#endif 
    382384   END SUBROUTINE tra_adv_fct 
    383385 
     
    676678   END SUBROUTINE tridia_solver 
    677679 
     680#if defined key_loop_fusion 
     681#define tracer_flux_i(out,zfp,zfm,ji,jj,jk) \ 
     682        zfp = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ; \ 
     683        zfm = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) ; \ 
     684        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji+1,jj,jk,jn,Kbb) ) 
     685 
     686#define tracer_flux_j(out,zfp,zfm,ji,jj,jk) \ 
     687        zfp = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) ; \ 
     688        zfm = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) ; \ 
     689        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji,jj+1,jk,jn,Kbb) ) 
     690 
     691   SUBROUTINE tra_adv_fct_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,       & 
     692      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 
     693      !!---------------------------------------------------------------------- 
     694      !!                  ***  ROUTINE tra_adv_fct  *** 
     695      !!  
     696      !! **  Purpose :   Compute the now trend due to total advection of tracers 
     697      !!               and add it to the general trend of tracer equations 
     698      !! 
     699      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction 
     700      !!               (choice through the value of kn_fct) 
     701      !!               - on the vertical the 4th order is a compact scheme  
     702      !!               - corrected flux (monotonic correction)  
     703      !! 
     704      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
     705      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
     706      !!             - poleward advective heat and salt transport (ln_diaptr=T) 
     707      !!---------------------------------------------------------------------- 
     708      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index 
     709      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices 
     710      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index 
     711      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     712      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
     713      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4) 
     714      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
     715      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     716      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     717      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     718      ! 
     719      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices   
     720      REAL(wp) ::   ztra                                     ! local scalar 
     721      REAL(wp) ::   zwx_im1, zfp_ui, zfp_ui_m1, zfp_vj, zfp_vj_m1, zfp_wk, zC2t_u, zC4t_u   !   -      - 
     722      REAL(wp) ::   zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v   !   -      - 
     723      REAL(wp) ::   ztu, ztv, ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1   
     724      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d 
     725      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
     726      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup 
     727      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection 
     728      !!---------------------------------------------------------------------- 
     729      ! 
     730      IF( kt == kit000 )  THEN 
     731         IF(lwp) WRITE(numout,*) 
     732         IF(lwp) WRITE(numout,*) 'tra_adv_fct_lf : FCT advection scheme on ', cdtype 
     733         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     734      ENDIF 
     735      !! -- init to 0 
     736      zwx_3d(:,:,:) = 0._wp 
     737      zwy_3d(:,:,:) = 0._wp 
     738      zwz(:,:,:) = 0._wp 
     739      zwi(:,:,:) = 0._wp 
     740      ! 
     741      l_trd = .FALSE.            ! set local switches 
     742      l_hst = .FALSE. 
     743      l_ptr = .FALSE. 
     744      ll_zAimp = .FALSE. 
     745      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     746      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE.  
     747      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  & 
     748         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     749      ! 
     750      IF( l_trd .OR. l_hst )  THEN 
     751         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
     752         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     753      ENDIF 
     754      ! 
     755      IF( l_ptr ) THEN   
     756         ALLOCATE( zptry(jpi,jpj,jpk) ) 
     757         zptry(:,:,:) = 0._wp 
     758      ENDIF 
     759      ! 
     760      ! If adaptive vertical advection, check if it is needed on this PE at this time 
     761      IF( ln_zad_Aimp ) THEN 
     762         IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
     763      END IF 
     764      ! If active adaptive vertical advection, build tridiagonal matrix 
     765      IF( ll_zAimp ) THEN 
     766         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 
     767         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     768            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
     769            &                               / e3t(ji,jj,jk,Krhs) 
     770            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs) 
     771            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs) 
     772         END_3D 
     773      END IF 
     774      ! 
     775      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
     776         ! 
     777         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
     778         !                               !* upstream tracer flux in the k direction *! 
     779         DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! Interior value ( multiplied by wmask) 
     780            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 
     781            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 
     782            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 
     783         END_3D 
     784         IF( ln_linssh ) THEN               ! top ocean value (only in linear free surface as zwz has been w-masked) 
     785            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface 
     786               DO_2D( 1, 1, 1, 1 ) 
     787                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
     788               END_2D 
     789            ELSE                                        ! no cavities: only at the ocean surface 
     790               DO_2D( 1, 1, 1, 1 ) 
     791                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
     792               END_2D 
     793            ENDIF 
     794         ENDIF 
     795         !                
     796         !                    !* upstream tracer flux in the i and j direction  
     797         DO jk = 1, jpkm1 
     798            DO jj = 1, jpj-1 
     799               tracer_flux_i(zwx_3d(1,jj,jk),zfp_ui,zfm_ui,1,jj,jk) 
     800               tracer_flux_j(zwy_3d(1,jj,jk),zfp_vj,zfm_vj,1,jj,jk) 
     801            END DO 
     802            DO ji = 1, jpi-1 
     803               tracer_flux_i(zwx_3d(ji,1,jk),zfp_ui,zfm_ui,ji,1,jk) 
     804               tracer_flux_j(zwy_3d(ji,1,jk),zfp_vj,zfm_vj,ji,1,jk) 
     805            END DO 
     806            DO_2D( 1, 1, 1, 1 ) 
     807               tracer_flux_i(zwx_3d(ji,jj,jk),zfp_ui,zfm_ui,ji,jj,jk) 
     808               tracer_flux_i(zwx_im1,zfp_ui_m1,zfm_ui_m1,ji-1,jj,jk) 
     809               tracer_flux_j(zwy_3d(ji,jj,jk),zfp_vj,zfm_vj,ji,jj,jk) 
     810               tracer_flux_j(zwy_jm1,zfp_vj_m1,zfm_vj_m1,ji,jj-1,jk) 
     811               ztra = - ( zwx_3d(ji,jj,jk) - zwx_im1 + zwy_3d(ji,jj,jk) - zwy_jm1 + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) 
     812               !                               ! update and guess with monotonic sheme 
     813               pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   & 
     814                  &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk) 
     815               zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) & 
     816                  &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     817            END_2D 
     818         END DO 
     819          
     820         IF ( ll_zAimp ) THEN 
     821            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 ) 
     822            ! 
     823            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 
     824            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     825               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     826               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     827               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     828               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes 
     829            END_3D 
     830            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     831               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) & 
     832                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     833            END_3D 
     834            ! 
     835         END IF 
     836         !                 
     837         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
     838            ztrdx(:,:,:) = zwx_3d(:,:,:)   ;   ztrdy(:,:,:) = zwy_3d(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
     839         END IF 
     840         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     841         IF( l_ptr )   zptry(:,:,:) = zwy_3d(:,:,:)  
     842         ! 
     843         !        !==  anti-diffusive flux : high order minus low order  ==! 
     844         ! 
     845         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes 
     846         ! 
     847         CASE(  2  )                   !- 2nd order centered 
     848            DO_3D( 2, 1, 2, 1, 1, jpkm1 ) 
     849               zwx_3d(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx_3d(ji,jj,jk) 
     850               zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy_3d(ji,jj,jk) 
     851            END_3D 
     852            ! 
     853         CASE(  4  )                   !- 4th order centered 
     854            zltu_3d(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
     855            zltv_3d(:,:,jpk) = 0._wp 
     856            !                          ! Laplacian 
     857            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! 2nd derivative * 1/ 6 
     858                  !             ! 1st derivative (gradient) 
     859                  ztu = ( pt(ji+1,jj,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     860                  ztu_im1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk) 
     861                  ztv = ( pt(ji,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
     862                  ztv_jm1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk) 
     863                  !             ! 2nd derivative * 1/ 6 
     864                  zltu_3d(ji,jj,jk) = (  ztu + ztu_im1  ) * r1_6 
     865                  zltv_3d(ji,jj,jk) = (  ztv + ztv_jm1  ) * r1_6 
     866               END_2D 
     867            END DO 
     868            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     869            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', -1.0_wp , zltv_3d, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     870            ! 
     871            DO_3D( 2, 1, 2, 1, 1, jpkm1 ) 
     872               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points 
     873               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     874               !                                                        ! C4 minus upstream advective fluxes 
     875               ! round brackets added to fix the order of floating point operations 
     876               ! needed to ensure halo 1 - halo 2 compatibility 
     877               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu_3d(ji,jj,jk) - zltu_3d(ji+1,jj,jk)   & 
     878                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility 
     879                             &                             ) - zwx_3d(ji,jj,jk) 
     880               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv_3d(ji,jj,jk) - zltv_3d(ji,jj+1,jk)   & 
     881                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility 
     882                             &                             ) - zwy_3d(ji,jj,jk) 
     883            END_3D 
     884            ! 
     885         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
     886            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     887               ztu_im1 = ( pt(ji  ,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk) 
     888               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk) 
     889 
     890               ztv_jm1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk) 
     891               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk) 
     892               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
     893               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     894               !                                                  ! C4 interpolation of T at u- & v-points (x2) 
     895               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 ) 
     896               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 ) 
     897               !                                                  ! C4 minus upstream advective fluxes  
     898               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx_3d(ji,jj,jk) 
     899               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk) 
     900            END_3D 
     901            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     902            ! 
     903         END SELECT 
     904         !                       
     905         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values) 
     906         ! 
     907         CASE(  2  )                   !- 2nd order centered 
     908            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     909               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
     910                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
     911            END_3D 
     912            ! 
     913         CASE(  4  )                   !- 4th order COMPACT 
     914            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     915            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     916               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
     917            END_3D 
     918            ! 
     919         END SELECT 
     920         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0 
     921            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
     922         ENDIF 
     923         !          
     924         CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
     925         ! 
     926         IF ( ll_zAimp ) THEN 
     927            DO_3D( 1, 1, 1, 1, 1, jpkm1 )    !* trend and after field with monotonic scheme 
     928               !                                                ! total intermediate advective trends 
     929               ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   & 
     930                  &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   & 
     931                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
     932               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     933            END_3D 
     934            ! 
     935            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 
     936            ! 
     937            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     938               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     939               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     940               zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     941            END_3D 
     942         END IF 
     943         ! 
     944         !        !==  monotonicity algorithm  ==! 
     945         ! 
     946         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt ) 
     947         ! 
     948         !        !==  final trend with corrected fluxes  ==! 
     949         ! 
     950         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     951            ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   & 
     952               &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   & 
     953               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
     954            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) 
     955            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     956         END_3D 
     957         ! 
     958         IF ( ll_zAimp ) THEN 
     959            ! 
     960            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp 
     961            DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Interior value ( multiplied by wmask) 
     962               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     963               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     964               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     965               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic 
     966            END_3D 
     967            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     968               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) & 
     969                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     970            END_3D 
     971         END IF          
     972         ! NOT TESTED - NEED l_trd OR l_hst TRUE  
     973         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
     974            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx_3d(:,:,:)  ! <<< add anti-diffusive fluxes  
     975            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy_3d(:,:,:)  !     to upstream fluxes 
     976            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
     977            ! 
     978            IF( l_trd ) THEN              ! trend diagnostics 
     979               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
     980               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
     981               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     982            ENDIF 
     983            !                             ! heat/salt transport 
     984            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     985            ! 
     986         ENDIF 
     987         ! NOT TESTED - NEED l_ptr TRUE  
     988         IF( l_ptr ) THEN              ! "Poleward" transports 
     989            zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:)  ! <<< add anti-diffusive fluxes 
     990            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
     991         ENDIF 
     992         ! 
     993      END DO                     ! end of tracer loop 
     994      ! 
     995      IF ( ll_zAimp ) THEN 
     996         DEALLOCATE( zwdia, zwinf, zwsup ) 
     997      ENDIF 
     998      IF( l_trd .OR. l_hst ) THEN  
     999         DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
     1000      ENDIF 
     1001      IF( l_ptr ) THEN  
     1002         DEALLOCATE( zptry ) 
     1003      ENDIF 
     1004      ! 
     1005   END SUBROUTINE tra_adv_fct_lf 
     1006#endif 
    6781007   !!====================================================================== 
    6791008END MODULE traadv_fct 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_mus.F90

    r14757 r14801  
    3131   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    3232   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     33#if defined key_loop_fusion 
     34   USE traadv_mus_lf  ! MUSCL    scheme            (tra_adv_mus  routine - loop fusion version) 
     35#endif 
    3336 
    3437   IMPLICIT NONE 
     
    9396      !!---------------------------------------------------------------------- 
    9497      ! 
     98#if defined key_loop_fusion 
     99      CALL tra_adv_mus_lf ( kt, nit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups ) 
     100#else 
    95101      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    96102         IF( kt == kit000 )  THEN 
     
    240246      END DO                     ! end of tracer loop 
    241247      ! 
     248#endif 
    242249   END SUBROUTINE tra_adv_mus 
    243250 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_qck.F90

    r14776 r14801  
    2727   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2828   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     29#if defined key_loop_fusion 
     30   USE traadv_qck_lf   ! QCK    scheme            (tra_adv_qck  routine - loop fusion version) 
     31#endif 
    2932 
    3033   IMPLICIT NONE 
     
    9699      !!---------------------------------------------------------------------- 
    97100      ! 
     101#if defined key_loop_fusion 
     102      CALL tra_adv_qck_lf ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs ) 
     103#else 
    98104      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    99105         IF( kt == kit000 )  THEN 
     
    117123      CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
    118124      ! 
     125#endif 
    119126   END SUBROUTINE tra_adv_qck 
    120127 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_ubs.F90

    r14776 r14801  
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     28#if defined key_loop_fusion 
     29   USE traadv_ubs_lf  ! UBS      scheme            (tra_adv_ubs  routine - loop fusion version) 
     30#endif 
    2831 
    2932   IMPLICIT NONE 
     
    103106      !!---------------------------------------------------------------------- 
    104107      ! 
     108#if defined key_loop_fusion 
     109      CALL tra_adv_ubs_lf    ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v ) 
     110#else 
    105111      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    106112         IF( kt == kit000 )  THEN 
     
    260266      END DO 
    261267      ! 
     268#endif 
    262269   END SUBROUTINE tra_adv_ubs 
    263270 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcadv.F90

    r14757 r14801  
    2323   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2424   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    25    USE traadv_fct_lf  ! FCT      scheme           (tra_adv_fct  routine - loop fusion version) 
    2625   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
    27    USE traadv_mus_lf  ! MUSCL    scheme           (tra_adv_mus  routine - loop fusion version) 
    2826   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
    2927   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
     
    129127         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    130128      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    131          IF (nn_hls==2) THEN 
    132 #if defined key_loop_fusion 
    133             CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    134 #else 
    135129            CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    136 #endif 
    137          ELSE 
    138             CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    139          END IF 
    140130      CASE ( np_MUS )                                 ! MUSCL 
    141          IF (nn_hls==2) THEN 
    142 #if defined key_loop_fusion 
    143             CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    144 #else 
    145131            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    146 #endif 
    147          ELSE 
    148             CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    149          END IF 
    150132      CASE ( np_UBS )                                 ! UBS 
    151133         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
Note: See TracChangeset for help on using the changeset viewer.