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 13516 for NEMO/branches – NEMO

Changeset 13516 for NEMO/branches


Ignore:
Timestamp:
2020-09-24T20:38:10+02:00 (4 years ago)
Author:
hadcv
Message:

Tiling for tra_adv

Location:
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90

    r13237 r13516  
    1818   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
     20   ! TEMP: This change not necessary after trd_tra is tiled and extended haloes development 
     21   USE domain, ONLY : dom_tile 
    2022   USE domvvl         ! variable vertical scale factors 
    2123   USE sbcwave        ! wave module 
     
    6567   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
    6668   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    67     
     69 
     70   !! * Substitutions 
     71#  include "do_loop_substitute.h90" 
    6872#  include "domzgr_substitute.h90" 
    6973   !!---------------------------------------------------------------------- 
     
    8690      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
    8791      ! 
    88       INTEGER ::   jk   ! dummy loop index 
    89       REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace 
    90       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
     92      ! TEMP: This change not necessary after trd_tra is tiled 
     93      INTEGER ::   itile 
     94      INTEGER ::   ji, jj, jk   ! dummy loop index 
     95      ! TEMP: This change not necessary and can be ST_2D(nn_hls) if using XIOS (subdomain support) 
     96      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww   ! 3D workspace 
     97      ! TEMP: This change not necessary after trd_tra is tiled 
     98      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ztrdt, ztrds 
     99      ! TEMP: This change not necessary after extra haloes development 
     100      LOGICAL :: lskip 
    91101      !!---------------------------------------------------------------------- 
    92102      ! 
    93103      IF( ln_timing )   CALL timing_start('tra_adv') 
    94104      ! 
    95       !                                         !==  effective transport  ==! 
    96       zuu(:,:,jpk) = 0._wp 
    97       zvv(:,:,jpk) = 0._wp 
    98       zww(:,:,jpk) = 0._wp 
    99       IF( ln_wave .AND. ln_sdw )  THEN 
    100          DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    101             zuu(:,:,jk) =   & 
    102                &  e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
    103             zvv(:,:,jk) =   &  
    104                &  e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
    105             zww(:,:,jk) =   &  
    106                &  e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    107          END DO 
    108       ELSE 
    109          DO jk = 1, jpkm1 
    110             zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)               ! eulerian transport only 
    111             zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 
    112             zww(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk) 
    113          END DO 
    114       ENDIF 
    115       ! 
    116       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections 
    117          zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 
    118          zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 
    119       ENDIF 
    120       ! 
    121       zuu(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom 
    122       zvv(:,:,jpk) = 0._wp 
    123       zww(:,:,jpk) = 0._wp 
    124       ! 
    125       IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
    126          &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary) 
    127       ! 
    128       IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary) 
    129       ! 
    130       CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport       
    131       CALL iom_put( "vocetr_eff", zvv ) 
    132       CALL iom_put( "wocetr_eff", zww ) 
    133       ! 
    134 !!gm ??? 
    135       CALL dia_ptr( kt, Kmm, zvv )                                    ! diagnose the effective MSF  
    136 !!gm ??? 
    137       ! 
    138  
    139       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    140          ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    141          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    142          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    143       ENDIF 
    144       ! 
    145       SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    146       ! 
    147       CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    148          CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    149       CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    150          CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    151       CASE ( np_MUS )                                 ! MUSCL 
    152          CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )  
    153       CASE ( np_UBS )                                 ! UBS 
    154          CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    155       CASE ( np_QCK )                                 ! QUICKEST 
    156          CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    157       ! 
    158       END SELECT 
    159       ! 
    160       IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
    161          DO jk = 1, jpkm1 
    162             ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk) 
    163             ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk) 
    164          END DO 
    165          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    166          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds ) 
    167          DEALLOCATE( ztrdt, ztrds ) 
     105      lskip = .FALSE. 
     106 
     107      ! TEMP: These changes not necessary if using XIOS (subdomain support) 
     108      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     109         ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 
     110         ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     111         IF( l_trdtra ) ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
     112      ENDIF 
     113 
     114      ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*, ldf_eiv_dia) 
     115      IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia )  THEN 
     116         IF( ln_tile ) THEN 
     117            IF( ntile == 1 ) THEN 
     118               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
     119            ELSE 
     120               lskip = .TRUE. 
     121            ENDIF 
     122         ENDIF 
     123      ENDIF 
     124      IF( .NOT. lskip ) THEN 
     125 
     126         ! TEMP: This change not necessary after trd_tra is tiled 
     127         itile = ntile 
     128         !                                         !==  effective transport  ==! 
     129         ! TODO: NOT TESTED- requires waves 
     130         IF( ln_wave .AND. ln_sdw )  THEN 
     131            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     132               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 
     133               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) 
     134               zww(ji,jj,jk) = e1e2t(ji,jj)                     * ( ww(ji,jj,jk)     + wsd(ji,jj,jk) ) 
     135            END_3D 
     136         ELSE 
     137            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     138               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only 
     139               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
     140               zww(ji,jj,jk) = e1e2t(ji,jj)                     * ww(ji,jj,jk) 
     141            END_3D 
     142         ENDIF 
     143         ! 
     144         ! TODO: NOT TESTED- requires ztilde 
     145         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections 
     146            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     147               zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 
     148               zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) 
     149            END_3D 
     150         ENDIF 
     151         ! 
     152         DO_2D( 1, 1, 1, 1 ) 
     153            zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom 
     154            zvv(ji,jj,jpk) = 0._wp 
     155            zww(ji,jj,jpk) = 0._wp 
     156         END_2D 
     157         ! 
     158         ! TEMP: These changes not necessary if using XIOS (subdomain support) 
     159         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
     160            &              CALL ldf_eiv_trp( kt, nit000, zuu(ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), & 
     161            &                                'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary) 
     162         ! 
     163         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu(ST_2D(nn_hls),:), zvv(ST_2D(nn_hls),:), zww(ST_2D(nn_hls),:), & 
     164            &                                'TRA', Kmm       )   ! add the mle transport (if necessary) 
     165         ! 
     166         ! TEMP: This change not necessary if using XIOS (subdomain support) 
     167         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     168            CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport 
     169            CALL iom_put( "vocetr_eff", zvv ) 
     170            CALL iom_put( "wocetr_eff", zww ) 
     171         ENDIF 
     172         ! 
     173   !!gm ??? 
     174         ! TEMP: This change not necessary if using XIOS (subdomain support) 
     175         CALL dia_ptr( kt, Kmm, zvv(ST_2D(nn_hls),:) )                                    ! diagnose the effective MSF 
     176   !!gm ??? 
     177         ! 
     178 
     179         IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     180            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     181               ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     182               ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 
     183            END_3D 
     184         ENDIF 
     185         ! 
     186         SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
     187         ! 
     188         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
     189            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
     190         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
     191            CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
     192         CASE ( np_MUS )                                 ! MUSCL 
     193            CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
     194         CASE ( np_UBS )                                 ! UBS 
     195            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
     196         CASE ( np_QCK )                                 ! QUICKEST 
     197            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
     198         ! 
     199         END SELECT 
     200         ! 
     201         ! TEMP: These changes not necessary after trd_tra is tiled 
     202         IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     203            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     204               ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     205               ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 
     206            END_3D 
     207 
     208            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     209               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     210 
     211               ! TODO: TO BE TILED- trd_tra 
     212               CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt ) 
     213               CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds ) 
     214               DEALLOCATE( ztrdt, ztrds ) 
     215 
     216               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     217            ENDIF 
     218         ENDIF 
     219 
     220         ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*, ldf_eiv_dia) 
     221         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 
     222 
    168223      ENDIF 
    169224      !                                              ! print mean trends (used for debugging) 
    170       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    171          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     225      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask, & 
     226         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, & 
     227         &                                  clinfo3='tra' ) 
     228 
     229      ! TEMP: This change not necessary if using XIOS (subdomain support) 
     230      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     231         DEALLOCATE( zuu, zvv, zww ) 
     232      ENDIF 
    172233      ! 
    173234      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90

    r13295 r13516  
    1212   !!---------------------------------------------------------------------- 
    1313   USE dom_oce        ! ocean space and time domain 
     14   ! TEMP: This change not necessary after trd_tra is tiled 
     15   USE domain, ONLY : dom_tile 
    1416   USE eosbn2         ! equation of state 
    1517   USE traadv_fct     ! acces to routine interp_4th_cpt  
     
    7173      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    7274      INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme) 
     75      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    7376      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    7477      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     
    7679      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    7780      INTEGER  ::   ierr             ! local integer 
    78       REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars 
    79       REAL(wp) ::   zC2t_v, zC4t_v   !   -      - 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw 
     81      ! TEMP: This change not necessary after trd_tra is tiled 
     82      INTEGER  ::   itile 
     83      REAL(wp) ::   zC2t_u, zC2t_v   ! local scalars 
     84      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw, zltu, zltv 
     85      ! TEMP: This change not necessary after trd_tra is tiled 
     86      REAL(wp), DIMENSION(:,:,:,:), SAVE, ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
    8187      !!---------------------------------------------------------------------- 
    82       ! 
    83       IF( kt == kit000 )  THEN 
    84          IF(lwp) WRITE(numout,*) 
    85          IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v 
    86          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
     88      ! TEMP: This change not necessary after trd_tra is tiled 
     89      itile = ntile 
     90      ! 
     91      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     92         IF( kt == kit000 )  THEN 
     93            IF(lwp) WRITE(numout,*) 
     94            IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v 
     95            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
     96         ENDIF 
     97         !                          ! set local switches 
     98         l_trd = .FALSE. 
     99         l_hst = .FALSE. 
     100         l_ptr = .FALSE. 
     101         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
     102         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )    l_ptr = .TRUE. 
     103         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     104            &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     105 
     106         ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     107         IF( kt == kit000 .AND. l_trd ) THEN 
     108            ALLOCATE( ztrdx(jpi,jpj,jpk,jpts), ztrdy(jpi,jpj,jpk,jpts), ztrdz(jpi,jpj,jpk,jpts) ) 
     109         ENDIF 
    87110      ENDIF 
    88       !                          ! set local switches 
    89       l_trd = .FALSE. 
    90       l_hst = .FALSE. 
    91       l_ptr = .FALSE. 
    92       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
    93       IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )    l_ptr = .TRUE.  
    94       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    95          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    96111      ! 
    97112      !                     
     
    110125            ! 
    111126         CASE(  4  )                         !* 4th order centered 
    112             ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero 
    113             ztv(:,:,jpk) = 0._wp 
    114             DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    115                ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    116                ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    117             END_3D 
    118             CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    119             ! 
    120             DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 
     127            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
     128            zltv(:,:,jpk) = 0._wp 
     129            DO jk = 1, jpkm1                 ! Laplacian 
     130               DO_2D( 1, 0, 1, 0 ) 
     131                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     132                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
     133               END_2D 
     134               DO_2D( 0, 0, 0, 0 ) 
     135                  zltu(ji,jj,jk) = ztu(ji,jj,jk) + ztu(ji-1,jj,jk) 
     136                  zltv(ji,jj,jk) = ztv(ji,jj,jk) + ztv(ji,jj-1,jk) 
     137               END_2D 
     138            END DO 
     139            CALL lbc_lnk_multi( 'traadv_cen', zltu, 'T', 1. , zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
     140            ! 
     141            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    121142               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2) 
    122143               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    123                !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    124                zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 
    125                zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 
    126144               !                                                  ! C4 fluxes 
    127                zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u 
    128                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
     145               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + r1_6 * (zltu(ji,jj,jk) - zltu(ji+1,jj,jk)) ) 
     146               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + r1_6 * (zltv(ji,jj,jk) - zltv(ji,jj+1,jk)) ) 
    129147            END_3D 
    130148            ! 
     
    149167         ! 
    150168         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask) 
     169            ! TODO: NOT TESTED- requires isf 
    151170            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    152171               DO_2D( 1, 1, 1, 1 ) 
     
    154173               END_2D 
    155174            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
    156                zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 
     175               DO_2D( 1, 1, 1, 1 ) 
     176                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 
     177               END_2D 
    157178            ENDIF 
    158179         ENDIF 
     
    166187         END_3D 
    167188         !                             ! trend diagnostics 
     189         ! TEMP: These changes not necessary after trd_tra is tiled 
    168190         IF( l_trd ) THEN 
    169             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
    170             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 
    171             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 
    172          END IF 
    173          !                                 ! "Poleward" heat and salt transports  
     191            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     192               ztrdx(ji,jj,jk,jn) = zwx(ji,jj,jk) 
     193               ztrdy(ji,jj,jk,jn) = zwy(ji,jj,jk) 
     194               ztrdz(ji,jj,jk,jn) = zwz(ji,jj,jk) 
     195            END_3D 
     196 
     197            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     198               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     199 
     200               ! TODO: TO BE TILED- trd_tra 
     201               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx(:,:,:,jn), pU, pt(:,:,:,jn,Kmm) ) 
     202               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy(:,:,:,jn), pV, pt(:,:,:,jn,Kmm) ) 
     203               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz(:,:,:,jn), pW, pt(:,:,:,jn,Kmm) ) 
     204 
     205               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     206            ENDIF 
     207         ENDIF 
     208         !                                 ! "Poleward" heat and salt transports 
    174209         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    175210         !                                 !  heat and salt transport 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90

    r13295 r13516  
    1515   USE oce            ! ocean dynamics and active tracers 
    1616   USE dom_oce        ! ocean space and time domain 
     17   ! TEMP: This change not necessary after trd_tra is tiled 
     18   USE domain, ONLY : dom_tile 
    1719   USE trc_oce        ! share passive tracers/Ocean variables 
    1820   USE trd_oce        ! trends: ocean variables 
     
    7981      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    8082      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     83      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    8184      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8285      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8386      ! 
    8487      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices   
     88      ! TEMP: This change not necessary after trd_tra is tiled 
     89      INTEGER  ::   itile 
    8590      REAL(wp) ::   ztra                                     ! local scalar 
    8691      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    8792      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    89       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
    90       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup 
     93      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
     94      ! TEMP: This change not necessary after trd_tra is tiled 
     95      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
     96      REAL(wp), DIMENSION(:,:,:)      , ALLOCATABLE ::   zptry 
     97      REAL(wp), DIMENSION(:,:,:)      , ALLOCATABLE ::   zwinf, zwdia, zwsup 
    9198      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection 
    9299      !!---------------------------------------------------------------------- 
    93       ! 
    94       IF( kt == kit000 )  THEN 
    95          IF(lwp) WRITE(numout,*) 
    96          IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 
    97          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    98       ENDIF 
     100      ! TEMP: This change not necessary after trd_tra is tiled 
     101      itile = ntile 
     102      ! 
     103      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     104         IF( kt == kit000 )  THEN 
     105            IF(lwp) WRITE(numout,*) 
     106            IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 
     107            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     108         ENDIF 
    99109      !! -- init to 0 
    100110      zwi(:,:,:) = 0._wp 
     
    107117      zltv(:,:,:) = 0._wp 
    108118      ztw(:,:,:) = 0._wp 
    109       ! 
    110       l_trd = .FALSE.            ! set local switches 
    111       l_hst = .FALSE. 
    112       l_ptr = .FALSE. 
    113       ll_zAimp = .FALSE. 
    114       IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    115       IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE.  
    116       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  & 
    117          &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    118       ! 
    119       IF( l_trd .OR. l_hst )  THEN 
    120          ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
    121          ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     119         ! 
     120         l_trd = .FALSE.            ! set local switches 
     121         l_hst = .FALSE. 
     122         l_ptr = .FALSE. 
     123         ll_zAimp = .FALSE. 
     124         IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     125         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE. 
     126         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  & 
     127            &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     128         ! 
     129         ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     130         IF( kt == kit000 .AND. (l_trd .OR. l_hst) )  THEN 
     131            ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
     132         ENDIF 
    122133      ENDIF 
    123134      ! 
    124135      IF( l_ptr ) THEN   
    125          ALLOCATE( zptry(jpi,jpj,jpk) ) 
     136         ALLOCATE( zptry(ST_2D(nn_hls),jpk) ) 
    126137         zptry(:,:,:) = 0._wp 
    127138      ENDIF 
     
    134145      ! If adaptive vertical advection, check if it is needed on this PE at this time 
    135146      IF( ln_zad_Aimp ) THEN 
    136          IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
     147         IF( MAXVAL( ABS( wi(ST_2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
    137148      END IF 
    138149      ! If active adaptive vertical advection, build tridiagonal matrix 
    139150      IF( ll_zAimp ) THEN 
    140          ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 
     151         ALLOCATE(zwdia(ST_2D(nn_hls),jpk), zwinf(ST_2D(nn_hls),jpk), zwsup(ST_2D(nn_hls),jpk)) 
    141152         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    142153            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
     
    167178         END_3D 
    168179         IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked) 
     180            ! TODO: NOT TESTED- requires isf 
    169181            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface 
    170182               DO_2D( 1, 1, 1, 1 ) 
     
    207219         END IF 
    208220         !                 
     221         ! TEMP: This change not necessary after trd_tra is tiled 
    209222         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    210             ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
     223            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     224               ztrdx(ji,jj,jk) = zwx(ji,jj,jk)   ;   ztrdy(ji,jj,jk) = zwy(ji,jj,jk)   ;   ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 
     225            END_3D 
    211226         END IF 
    212227         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     
    336351         END IF          
    337352         ! 
     353         ! TEMP: These changes not necessary after trd_tra is tiled 
    338354         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
    339             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes  
    340             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes 
    341             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
    342             ! 
    343             IF( l_trd ) THEN              ! trend diagnostics 
    344                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
    345                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
    346                CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     355            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     356               ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk)  ! <<< add anti-diffusive fluxes 
     357               ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk)  !     to upstream fluxes 
     358               ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk)  ! 
     359            END_3D 
     360            ! 
     361            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     362               IF( l_trd ) THEN              ! trend diagnostics 
     363                  IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     364 
     365                  ! TODO: TO BE TILED- trd_tra 
     366                  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
     367                  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
     368                  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     369 
     370                  IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     371               ENDIF 
    347372            ENDIF 
    348373            !                             ! heat/salt transport 
    349             IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     374            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(ST_2D(nn_hls),:), ztrdy(ST_2D(nn_hls),:) ) 
    350375            ! 
    351376         ENDIF 
     
    360385         DEALLOCATE( zwdia, zwinf, zwsup ) 
    361386      ENDIF 
    362       IF( l_trd .OR. l_hst ) THEN  
    363          DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
    364       ENDIF 
     387      ! TEMP: These changes not necessary after trd_tra is tiled 
     388!      IF( l_trd .OR. l_hst ) THEN 
     389!         DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
     390!      ENDIF 
    365391      IF( l_ptr ) THEN  
    366392         DEALLOCATE( zptry ) 
     
    383409      !!       in-space based differencing for fluid 
    384410      !!---------------------------------------------------------------------- 
    385       INTEGER                          , INTENT(in   ) ::   Kmm             ! time level index  
    386       REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step 
    387       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    388       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
     411      INTEGER                         , INTENT(in   ) ::   Kmm             ! time level index 
     412      REAL(wp)                        , INTENT(in   ) ::   p2dt            ! tracer time-step 
     413      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field 
     414      REAL(wp), DIMENSION(ST_2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field 
     415      REAL(wp), DIMENSION(ST_2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    389416      ! 
    390417      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    392419      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
    393420      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    394       REAL(dp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     421      REAL(dp), DIMENSION(ST_2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo 
    395422      !!---------------------------------------------------------------------- 
    396423      ! 
     
    402429      ! -------------------- 
    403430      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 
    404       zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   & 
    405          &        paft * tmask - zbig * ( 1._wp - tmask )  ) 
    406       zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   & 
    407          &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
     431      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     432         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   & 
     433            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  ) 
     434         zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ),   & 
     435            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) )  ) 
     436      END_3D 
    408437 
    409438      DO jk = 1, jpkm1 
     
    537566      !!---------------------------------------------------------------------- 
    538567      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point 
    539       REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point 
     568      REAL(wp),DIMENSION(ST_2D(nn_hls)    ,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point 
    540569      ! 
    541570      INTEGER ::   ji, jj, jk   ! dummy loop integers 
    542571      INTEGER ::   ikt, ikb     ! local integers 
    543       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 
     572      REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt 
    544573      !!---------------------------------------------------------------------- 
    545574      ! 
     
    561590!!gm   
    562591      ! 
     592      ! TODO: NOT TESTED- requires isf 
    563593      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case 
    564594         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp 
     
    626656      !!        The 3d array zwt is used as a work space array. 
    627657      !!---------------------------------------------------------------------- 
    628       REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix 
    629       REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pRHS          ! Right-Hand-Side 
    630       REAL(wp),DIMENSION(:,:,:), INTENT(  out) ::   pt_out        !!gm field at level=F(klev) 
    631       INTEGER                  , INTENT(in   ) ::   klev          ! =1 pt_out at w-level  
    632       !                                                           ! =0 pt at t-level 
     658      REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix 
     659      REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in   ) ::   pRHS          ! Right-Hand-Side 
     660      REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(  out) ::   pt_out        !!gm field at level=F(klev) 
     661      INTEGER                    , INTENT(in   ) ::   klev          ! =1 pt_out at w-level 
     662      !                                                             ! =0 pt at t-level 
    633663      INTEGER ::   ji, jj, jk   ! dummy loop integers 
    634664      INTEGER ::   kstart       ! local indices 
    635       REAL(wp),DIMENSION(jpi,jpj,jpk) ::   zwt   ! 3D work array 
     665      REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) ::   zwt   ! 3D work array 
    636666      !!---------------------------------------------------------------------- 
    637667      ! 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90

    r13295 r13516  
    1919   USE trc_oce        ! share passive tracers/Ocean variables 
    2020   USE dom_oce        ! ocean space and time domain 
     21   ! TEMP: This change not necessary after trd_tra is tiled 
     22   USE domain, ONLY : dom_tile 
    2123   USE trd_oce        ! trends: ocean variables 
    2224   USE trdtra         ! tracers trends manager 
     
    8183      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8284      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     85      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    8386      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8487      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8588      ! 
     89      ! TEMP: This change not necessary after trd_tra is tiled 
     90      INTEGER  ::   itile 
    8691      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    8792      INTEGER  ::   ierr             ! local integer 
    8893      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
    8994      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
    90       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zslpx   ! 3D workspace 
    91       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zslpy   ! -      -  
     95      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwx, zslpx   ! 3D workspace 
     96      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwy, zslpy   ! -      - 
     97      ! TEMP: This change not necessary after trd_tra is tiled 
     98      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
    9299      !!---------------------------------------------------------------------- 
    93       ! 
    94       IF( kt == kit000 )  THEN 
    95          IF(lwp) WRITE(numout,*) 
    96          IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 
    97          IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups 
    98          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    99          IF(lwp) WRITE(numout,*) 
    100          ! 
    101          ! Upstream / MUSCL scheme indicator 
    102          ! 
    103          ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
    104          xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
    105          ! 
    106          IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    107             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    108             upsmsk(:,:) = 0._wp                             ! not upstream by default 
    109             ! 
    110             DO jk = 1, jpkm1 
    111                xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed 
    112                   &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows) 
    113                   &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area 
    114             END DO 
    115          ENDIF  
    116          ! 
    117       ENDIF  
    118       !       
    119       l_trd = .FALSE. 
    120       l_hst = .FALSE. 
    121       l_ptr = .FALSE. 
    122       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    123       IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE.  
    124       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    125          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
     100      ! TEMP: This change not necessary after trd_tra is tiled 
     101      itile = ntile 
     102      ! 
     103      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     104         IF( kt == kit000 )  THEN 
     105            IF(lwp) WRITE(numout,*) 
     106            IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 
     107            IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups 
     108            IF(lwp) WRITE(numout,*) '~~~~~~~' 
     109            IF(lwp) WRITE(numout,*) 
     110            ! 
     111            ! Upstream / MUSCL scheme indicator 
     112            ! 
     113            ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
     114            xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
     115            ! 
     116            IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
     117               ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
     118               upsmsk(:,:) = 0._wp                             ! not upstream by default 
     119               ! 
     120               DO jk = 1, jpkm1 
     121                  xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed 
     122                     &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows) 
     123                     &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area 
     124               END DO 
     125            ENDIF 
     126            ! 
     127         ENDIF 
     128         ! 
     129         l_trd = .FALSE. 
     130         l_hst = .FALSE. 
     131         l_ptr = .FALSE. 
     132         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     133         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE. 
     134         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     135            &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
     136 
     137         ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     138         IF( kt == kit000 .AND. l_trd ) THEN 
     139            ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
     140         ENDIF 
     141      ENDIF 
    126142      ! 
    127143      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
     
    181197         END_3D 
    182198         !                                ! trend diagnostics 
     199         ! TEMP: These changes not necessary after trd_tra is tiled 
    183200         IF( l_trd )  THEN 
    184             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) ) 
    185             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 
     201            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     202               ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 
     203               ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 
     204            END_3D 
     205 
     206            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     207               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     208 
     209               ! TODO: TO BE TILED- trd_tra 
     210               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kbb) ) 
     211               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kbb) ) 
     212 
     213               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )   ! Revert to tile domain 
     214            ENDIF 
    186215         END IF 
    187216         !                                 ! "Poleward" heat and salt transports  
     
    195224         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions 
    196225         zwx(:,:,jpk) = 0._wp 
    197          DO jk = 2, jpkm1                       ! interior values 
    198             zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn,Kbb) - pt(:,:,jk,jn,Kbb) ) 
    199          END DO 
     226         DO_3D( 1, 1, 1, 1, 2, jpkm1 )                ! interior values 
     227            zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
     228         END_3D 
    200229         !                                !-- Slopes of tracer 
    201230         zslpx(:,:,1) = 0._wp                   ! surface values 
     
    218247         END_3D 
    219248         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
     249            ! TODO: NOT TESTED- requires isf 
    220250            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    221251               DO_2D( 1, 1, 1, 1 ) 
     
    223253               END_2D 
    224254            ELSE                                      ! no cavities: only at the ocean surface 
    225                zwx(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 
     255               DO_2D( 1, 1, 1, 1 ) 
     256                  zwx(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
     257               END_2D 
    226258            ENDIF 
    227259         ENDIF 
     
    232264         END_3D 
    233265         !                                ! send trends for diagnostic 
    234          IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) ) 
     266         ! TEMP: These changes not necessary after trd_tra is tiled 
     267         IF( l_trd ) THEN 
     268            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     269               ztrdz(ji,jj,jk) = zwx(ji,jj,jk) 
     270            END_3D 
     271 
     272            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     273               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     274 
     275               ! TODO: TO BE TILED- trd_tra 
     276               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kbb) ) 
     277 
     278               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     279            ENDIF 
     280         ENDIF 
    235281         ! 
    236282      END DO                     ! end of tracer loop 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90

    r13295 r13516  
    1717   USE oce             ! ocean dynamics and active tracers 
    1818   USE dom_oce         ! ocean space and time domain 
     19   ! TEMP: This change not necessary after trd_tra is tiled 
     20   USE domain, ONLY : dom_tile 
    1921   USE trc_oce         ! share passive tracers/Ocean variables 
    2022   USE trd_oce         ! trends: ocean variables 
     
    9193      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
    9294      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     95      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    9396      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9497      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9598      !!---------------------------------------------------------------------- 
    9699      ! 
    97       IF( kt == kit000 )  THEN 
    98          IF(lwp) WRITE(numout,*) 
    99          IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 
    100          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    101          IF(lwp) WRITE(numout,*) 
     100      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     101         IF( kt == kit000 )  THEN 
     102            IF(lwp) WRITE(numout,*) 
     103            IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 
     104            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     105            IF(lwp) WRITE(numout,*) 
     106         ENDIF 
     107         ! 
     108         l_trd = .FALSE. 
     109         l_ptr = .FALSE. 
     110         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
     111         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 
    102112      ENDIF 
    103       ! 
    104       l_trd = .FALSE. 
    105       l_ptr = .FALSE. 
    106       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    107       IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.  
    108113      ! 
    109114      ! 
     
    127132      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    128133      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
     134      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    129135      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components 
    130136      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    131137      !! 
     138      ! TEMP: This change not necessary after trd_tra is tiled 
     139      INTEGER  ::   itile 
    132140      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    133141      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    134       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zfu, zfc, zfd 
     142      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwx, zfu, zfc, zfd 
     143      ! TEMP: This change not necessary after trd_tra is tiled 
     144      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdx 
    135145      !---------------------------------------------------------------------- 
    136       ! 
     146      ! TEMP: This change not necessary after trd_tra is tiled 
     147      itile = ntile 
     148      ! 
     149      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     150      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     151         IF( kt == nit000 .AND. l_trd ) THEN 
     152            ALLOCATE( ztrdx(jpi,jpj,jpk) ) 
     153         ENDIF 
     154      ENDIF 
    137155      !                                                          ! =========== 
    138156      DO jn = 1, kjpt                                            ! tracer loop 
     
    200218         END_3D 
    201219         !                                 ! trend diagnostics 
    202          IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
     220         ! TEMP: These changes not necessary after trd_tra is tiled 
     221         IF( l_trd )  THEN 
     222            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     223               ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 
     224            END_3D 
     225 
     226            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     227               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     228 
     229               ! TODO: TO BE TILED- trd_tra 
     230               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
     231 
     232               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     233            ENDIF 
     234         ENDIF 
    203235         ! 
    204236      END DO 
     
    216248      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    217249      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
     250      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    218251      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components 
    219252      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    220253      !! 
     254      ! TEMP: This change not necessary after trd_tra is tiled 
     255      INTEGER  ::   itile 
    221256      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    222257      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    223       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace 
     258      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace 
     259      ! TEMP: This change not necessary after trd_tra is tiled 
     260      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdy 
    224261      !---------------------------------------------------------------------- 
    225       ! 
     262      ! TEMP: This change not necessary after trd_tra is tiled 
     263      itile = ntile 
     264      ! 
     265      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     266      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     267         IF( kt == nit000 .AND. l_trd ) THEN 
     268            ALLOCATE( ztrdy(jpi,jpj,jpk) ) 
     269         ENDIF 
     270      ENDIF 
    226271      !                                                          ! =========== 
    227272      DO jn = 1, kjpt                                            ! tracer loop 
     
    296341         END_3D 
    297342         !                                 ! trend diagnostics 
    298          IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 
     343         ! TEMP: These changes not necessary after trd_tra is tiled 
     344         IF( l_trd )  THEN 
     345            DO_3D( 1, 0, 1, 0, 1, jpk ) 
     346               ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 
     347            END_3D 
     348 
     349            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     350               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     351 
     352               ! TODO: TO BE TILED- trd_tra 
     353               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
     354 
     355               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     356            ENDIF 
     357         ENDIF 
    299358         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    300359         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     
    313372      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    314373      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers 
    315       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity  
     374      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     375      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity 
    316376      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    317377      ! 
     378      ! TEMP: This change not necessary after trd_tra is tiled 
     379      INTEGER  ::   itile 
    318380      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    319       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz   ! 3D workspace 
    320       !!---------------------------------------------------------------------- 
    321       ! 
     381      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zwz   ! 3D workspace 
     382      ! TEMP: This change not necessary after trd_tra is tiled 
     383      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdz 
     384      !!---------------------------------------------------------------------- 
     385      ! TEMP: This change not necessary after trd_tra is tiled 
     386      itile = ntile 
     387      ! 
     388      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     389      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     390         IF( kt == nit000 .AND. l_trd ) THEN 
     391            ALLOCATE( ztrdz(jpi,jpj,jpk) ) 
     392         ENDIF 
     393      ENDIF 
     394 
    322395      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers 
    323396      zwz(:,:,jpk) = 0._wp 
     
    331404         END_3D 
    332405         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
     406            ! TODO: NOT TESTED- requires isf 
    333407            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    334408               DO_2D( 1, 1, 1, 1 ) 
     
    336410               END_2D 
    337411            ELSE                                   ! no ocean cavities (only ocean surface) 
    338                zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 
     412               DO_2D( 1, 1, 1, 1 ) 
     413                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 
     414               END_2D 
    339415            ENDIF 
    340416         ENDIF 
     
    345421         END_3D 
    346422         !                                 ! Send trends for diagnostic 
    347          IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 
     423         ! TEMP: These changes not necessary after trd_tra is tiled 
     424         IF( l_trd )  THEN 
     425            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     426               ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 
     427            END_3D 
     428 
     429            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     430               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     431 
     432               ! TODO: TO BE TILED- trd_tra 
     433               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     434 
     435               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     436            ENDIF 
     437         ENDIF 
    348438         ! 
    349439      END DO 
     
    359449      !! ** Method :    
    360450      !!---------------------------------------------------------------------- 
    361       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfu   ! second upwind point 
    362       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfd   ! first douwning point 
    363       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point) 
    364       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux 
     451      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in   ) ::   pfu   ! second upwind point 
     452      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in   ) ::   pfd   ! first douwning point 
     453      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point) 
     454      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux 
    365455      !! 
    366456      INTEGER  ::  ji, jj, jk               ! dummy loop indices  
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90

    r13295 r13516  
    1414   USE oce            ! ocean dynamics and active tracers 
    1515   USE dom_oce        ! ocean space and time domain 
     16   ! TEMP: This change not necessary after trd_tra is tiled 
     17   USE domain, ONLY : dom_tile 
    1618   USE trc_oce        ! share passive tracers/Ocean variables 
    1719   USE trd_oce        ! trends: ocean variables 
     
    9294      INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers 
    9395      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     96      ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
    9497      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9598      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9699      ! 
     100      ! TEMP: This change not necessary after trd_tra is tiled 
     101      INTEGER  ::   itile 
    97102      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    98103      REAL(wp) ::   ztra, zbtr, zcoef                       ! local scalars 
    99104      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
    100105      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zltu, zltv, zti, ztw   ! 3D workspace 
    102       !!---------------------------------------------------------------------- 
    103       ! 
    104       IF( kt == kit000 )  THEN 
    105          IF(lwp) WRITE(numout,*) 
    106          IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype 
    107          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     106      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   ztu, ztv, zltu, zltv, zti, ztw     ! 3D workspace 
     107      ! TEMP: This change not necessary after trd_tra is tiled 
     108      REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
     109      !!---------------------------------------------------------------------- 
     110      ! TEMP: This change not necessary after trd_tra is tiled 
     111      itile = ntile 
     112      ! 
     113      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     114         IF( kt == kit000 )  THEN 
     115            IF(lwp) WRITE(numout,*) 
     116            IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype 
     117            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     118         ENDIF 
     119         ! 
     120         l_trd = .FALSE. 
     121         l_hst = .FALSE. 
     122         l_ptr = .FALSE. 
     123         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     124         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE. 
     125         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     126            &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
     127 
     128         ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     129         IF( kt == kit000 .AND. l_trd ) THEN 
     130            ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
     131         ENDIF 
    108132      ENDIF 
    109       ! 
    110       l_trd = .FALSE. 
    111       l_hst = .FALSE. 
    112       l_ptr = .FALSE. 
    113       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    114       IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE.  
    115       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    116          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
    117133      ! 
    118134      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers 
     
    153169         END_3D 
    154170         ! 
    155          zltu(:,:,:) = pt(:,:,:,jn,Krhs)      ! store the initial trends before its update 
     171         DO_3D( 1, 1, 1, 1, 1, jpk ) 
     172            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update 
     173         END_3D 
    156174         ! 
    157175         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==! 
     
    165183         END DO 
    166184         ! 
    167          zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
    168          !                                            ! and/or in trend diagnostic (l_trd=T)  
    169          !                 
     185         DO_3D( 1, 1, 1, 1, 1, jpk ) 
     186            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case 
     187         END_3D                                                     ! and/or in trend diagnostic (l_trd=T) 
     188         ! 
     189         ! TEMP: These changes not necessary after trd_tra is tiled 
    170190         IF( l_trd ) THEN                  ! trend diagnostics 
    171              CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) ) 
    172              CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) ) 
     191            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     192               ztrdx(ji,jj,jk) = ztu(ji,jj,jk) 
     193               ztrdy(ji,jj,jk) = ztv(ji,jj,jk) 
     194            END_3D 
     195 
     196            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     197               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     198 
     199               ! TODO: TO BE TILED- trd_tra 
     200               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
     201               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
     202 
     203               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     204            ENDIF 
    173205         END IF 
    174206         !      
     
    185217         CASE(  2  )                   ! 2nd order FCT  
    186218            !          
    187             IF( l_trd )   zltv(:,:,:) = pt(:,:,:,jn,Krhs)          ! store pt(:,:,:,:,Krhs) if trend diag. 
     219            IF( l_trd ) THEN 
     220               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     221                  zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)          ! store pt(:,:,:,:,Krhs) if trend diag. 
     222               END_3D 
     223            ENDIF 
    188224            ! 
    189225            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==! 
     
    194230            END_3D 
    195231            IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked) 
     232               ! TODO: NOT TESTED- requires isf 
    196233               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface 
    197234                  DO_2D( 1, 1, 1, 1 ) 
     
    199236                  END_2D 
    200237               ELSE                                ! no cavities: only at the ocean surface 
    201                   ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 
     238                  DO_2D( 1, 1, 1, 1 ) 
     239                     ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
     240                  END_2D 
    202241               ENDIF 
    203242            ENDIF 
     
    226265               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    227266            END_3D 
    228             IF( ln_linssh )   ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work 
     267            IF( ln_linssh ) THEN 
     268               DO_2D( 1, 1, 1, 1 ) 
     269                  ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work 
     270               END_2D 
     271            ENDIF 
    229272            ! 
    230273         END SELECT 
     
    235278         END_3D 
    236279         ! 
     280         ! TEMP: These changes not necessary after trd_tra is tiled 
    237281         IF( l_trd )  THEN       ! vertical advective trend diagnostics 
    238282            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    239                zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          & 
     283               ztrdz(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          & 
    240284                  &           + pt(ji,jj,jk,jn,Kmm) * (  pW(ji,jj,jk) - pW(ji,jj,jk+1)  )   & 
    241285                  &                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    242286            END_3D 
    243             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv ) 
     287 
     288            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     289               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     290 
     291               ! TODO: TO BE TILED- trd_tra 
     292               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz ) 
     293 
     294               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     295            ENDIF 
    244296         ENDIF 
    245297         ! 
     
    262314      !!       in-space based differencing for fluid 
    263315      !!---------------------------------------------------------------------- 
    264       INTEGER , INTENT(in   )                          ::   Kmm    ! time level index 
    265       REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step 
    266       REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    267       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 
    268       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction 
     316      INTEGER , INTENT(in   )                         ::   Kmm    ! time level index 
     317      REAL(wp), INTENT(in   )                         ::   p2dt   ! tracer time-step 
     318      REAL(wp),                DIMENSION(jpi,jpj,jpk) ::   pbef   ! before field 
     319      REAL(wp), INTENT(inout), DIMENSION(ST_2D(nn_hls)    ,jpk) ::   paft   ! after field 
     320      REAL(wp), INTENT(inout), DIMENSION(ST_2D(nn_hls)    ,jpk) ::   pcc    ! monotonic flux in the k direction 
    269321      ! 
    270322      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    271323      INTEGER  ::   ikm1         ! local integer 
    272324      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars 
    273       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zbetup, zbetdo     ! 3D workspace 
     325      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zbetup, zbetdo         ! 3D workspace 
    274326      !!---------------------------------------------------------------------- 
    275327      ! 
     
    281333      ! -------------------- 
    282334      !                    ! large negative value (-zbig) inside land 
    283       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 
    284       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 
     335      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     336         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 
     337         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 
     338      END_3D 
    285339      ! 
    286340      DO jk = 1, jpkm1     ! search maximum in neighbourhood 
     
    293347      END DO 
    294348      !                    ! large positive value (+zbig) inside land 
    295       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 
    296       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 
     349      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     350         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 
     351         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 
     352      END_3D 
    297353      ! 
    298354      DO jk = 1, jpkm1     ! search minimum in neighbourhood 
     
    305361      END DO 
    306362      !                    ! restore masked values to zero 
    307       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) 
    308       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) 
     363      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     364         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) 
     365         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) 
     366      END_3D 
    309367      ! 
    310368      ! Positive and negative part of fluxes and beta terms 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90

    r13295 r13516  
    7979      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 
    8080      !!---------------------------------------------------------------------- 
    81       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    82       INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index 
    83       INTEGER                         , INTENT(in   ) ::   Kmm        ! ocean time level index 
    84       CHARACTER(len=3)                , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components 
    87       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
     81      INTEGER                     , INTENT(in   ) ::   kt         ! ocean time-step index 
     82      INTEGER                     , INTENT(in   ) ::   kit000     ! first time step index 
     83      INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index 
     84      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     85      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components 
     86      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pv         ! out: same 3  transport components 
     87      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
    8888      ! 
    8989      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     
    9191      REAL(wp) ::   zcuw, zmuw, zc      ! local scalar 
    9292      REAL(wp) ::   zcvw, zmvw          !   -      - 
    93       INTEGER , DIMENSION(jpi,jpj)     :: inml_mle 
    94       REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
    95       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 
     93      INTEGER , DIMENSION(ST_2D(nn_hls))     :: inml_mle 
     94      REAL(wp), DIMENSION(ST_2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH 
     95      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 
     96      ! TEMP: These changes not necessary if using XIOS (subdomain support) 
     97      REAL(wp), DIMENSION(:,:),   ALLOCATABLE, SAVE :: zLf_NH 
     98      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle 
    9699      !!---------------------------------------------------------------------- 
    97100      ! 
    98101      !                                      !==  MLD used for MLE  ==! 
    99102      !                                                ! compute from the 10m density to deal with the diurnal cycle 
    100       inml_mle(:,:) = mbkt(:,:) + 1                    ! init. to number of ocean w-level (T-level + 1) 
     103      DO_2D( 1, 1, 1, 1 ) 
     104         inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
     105      END_2D 
    101106      IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    102107         DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 
     
    135140      END SELECT 
    136141      !                                                ! convert density into buoyancy 
    137       zbm(:,:) = + grav * zbm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 
     142      DO_2D( 1, 1, 1, 1 ) 
     143         zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
     144      END_2D 
    138145      ! 
    139146      ! 
     
    206213      END DO 
    207214 
     215      ! TEMP: These changes not necessary if using XIOS (subdomain support) 
    208216      IF( cdtype == 'TRA') THEN              !==  outputs  ==! 
    209          ! 
    210          zLf_NH(:,:) = SQRT( rb_c * zmld(:,:) ) * r1_ft(:,:)      ! Lf = N H / f 
    211          CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
     217         IF( kt == nit000 .AND. (ntile == 0 .OR. ntile == 1) )  THEN             ! Do only on the first tile and timestep 
     218            ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) ) 
     219         ENDIF 
     220         ! 
     221         DO_2D( 1, 1, 1, 1 ) 
     222            zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
     223         END_2D 
    212224         ! 
    213225         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    214          DO jk = 1, ikmax+1 
    215             zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:) 
    216             zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:) 
    217          END DO 
    218          CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction 
    219          CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
     226         DO_3D( 1, 1, 1, 1, 1, ikmax+1 ) 
     227            zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 
     228            zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 
     229         END_3D 
     230 
     231         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     232            CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
     233            CALL iom_put( "psiu_mle", zpsiu_mle )    ! i-mle streamfunction 
     234            CALL iom_put( "psiv_mle", zpsiv_mle )    ! j-mle streamfunction 
     235         ENDIF 
    220236      ENDIF 
    221237      ! 
Note: See TracChangeset for help on using the changeset viewer.