Changeset 13515


Ignore:
Timestamp:
2020-09-24T20:32:14+02:00 (4 months ago)
Author:
hadcv
Message:

Tiling for tra_ldf

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

Legend:

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

    r13295 r13515  
    302302      INTEGER  ::   iku, ikv                         ! temporary integers 
    303303      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    304       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
    305       REAL(wp), DIMENSION(jpi,jpj) :: zgtsu, zgtsv, zgru, zgrv 
     304      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 
     305      REAL(wp), DIMENSION(jpi,jpj,1)   :: zgtsu, zgtsv 
     306      REAL(wp), DIMENSION(jpi,jpj)     :: zgru, zgrv 
    306307      !!---------------------------------------------------------------------- 
    307308      ! 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90

    r13295 r13515  
    726726      !! ** Action  : pu, pv increased by the eiv transport 
    727727      !!---------------------------------------------------------------------- 
    728       INTEGER                         , INTENT(in   ) ::   kt        ! ocean time-step index 
    729       INTEGER                         , INTENT(in   ) ::   kit000    ! first time step index 
    730       INTEGER                         , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices 
    731       CHARACTER(len=3)                , INTENT(in   ) ::   cdtype    ! =TRA or TRC (tracer indicator) 
    732       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu      ! in : 3 ocean transport components   [m3/s] 
    733       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv      ! out: 3 ocean transport components   [m3/s] 
    734       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw      ! increased by the eiv                [m3/s] 
     728      INTEGER                     , INTENT(in   ) ::   kt        ! ocean time-step index 
     729      INTEGER                     , INTENT(in   ) ::   kit000    ! first time step index 
     730      INTEGER                     , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices 
     731      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype    ! =TRA or TRC (tracer indicator) 
     732      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pu        ! in : 3 ocean transport components   [m3/s] 
     733      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pv        ! out: 3 ocean transport components   [m3/s] 
     734      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   pw        ! increased by the eiv                [m3/s] 
    735735      !! 
    736736      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    737737      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    738738      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
    739       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
    740       !!---------------------------------------------------------------------- 
    741       ! 
    742       IF( kt == kit000 )  THEN 
    743          IF(lwp) WRITE(numout,*) 
    744          IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 
    745          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component' 
     739      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zpsi_uw, zpsi_vw 
     740      !!---------------------------------------------------------------------- 
     741      ! 
     742      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     743         IF( kt == kit000 )  THEN 
     744            IF(lwp) WRITE(numout,*) 
     745            IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 
     746            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component' 
     747         ENDIF 
    746748      ENDIF 
    747749 
     
    782784      !! 
    783785      !!---------------------------------------------------------------------- 
    784       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
    785       INTEGER                         , INTENT(in   ) ::   Kmm   ! ocean time level indices 
     786      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
     787      INTEGER                     , INTENT(in   ) ::   Kmm   ! ocean time level indices 
    786788      ! 
    787789      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    788790      REAL(wp) ::   zztmp   ! local scalar 
    789       REAL(wp), DIMENSION(jpi,jpj)     ::   zw2d   ! 2D workspace 
    790       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d   ! 3D workspace 
     791      REAL(wp), DIMENSION(ST_2D(nn_hls))     ::   zw2d   ! 2D workspace 
     792      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zw3d   ! 3D workspace 
    791793      !!---------------------------------------------------------------------- 
    792794      ! 
     
    803805      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
    804806      ! 
    805       DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    806          zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u(:,:,jk,Kmm) ) 
    807       END DO 
     807      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                                  ! e2u e3u u_eiv = -dk[psi_uw] 
     808         zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) ) 
     809      END_3D 
    808810      CALL iom_put( "uoce_eiv", zw3d ) 
    809811      ! 
    810       DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    811          zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v(:,:,jk,Kmm) ) 
    812       END DO 
     812      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                                  ! e1v e3v v_eiv = -dk[psi_vw] 
     813         zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) ) 
     814      END_3D 
    813815      CALL iom_put( "voce_eiv", zw3d ) 
    814816      ! 
     
    821823      ! 
    822824      IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value 
    823          zw2d(:,:) = rho0 * e1e2t(:,:) 
     825         DO_2D( 1, 1, 1, 1 ) 
     826            zw2d(ji,jj) = rho0 * e1e2t(ji,jj) 
     827         END_2D 
    824828         DO jk = 1, jpk 
    825829            zw3d(:,:,jk) = zw3d(:,:,jk) * zw2d(:,:) 
     
    867871      END_3D 
    868872      CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 
    869       CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
    870       CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction 
     873      CALL lbc_lnk( 'ldftra', zw3d, 'V', -1. ) 
     874      CALL iom_put( "veiv_heattr"  , zztmp * zw2d )                  !  heat transport in j-direction 
     875      CALL iom_put( "veiv_heattr3d", zztmp * zw3d )                  !  heat transport in j-direction 
    871876      ! 
    872877      IF( iom_use( 'sophteiv' ) )   CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) 
     
    894899      END_3D 
    895900      CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 
    896       CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 
    897       CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction 
     901      CALL lbc_lnk( 'ldftra', zw3d, 'V', -1. ) 
     902      CALL iom_put( "veiv_salttr"  , zztmp * zw2d )                  !  salt transport in j-direction 
     903      CALL iom_put( "veiv_salttr3d", zztmp * zw3d )                  !  salt transport in j-direction 
    898904      ! 
    899905      IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90

    r13295 r13515  
    3939   !!---------------------------------------------------------------------- 
    4040   USE dom_oce        ! ocean space and time domain 
     41   USE domutl, ONLY : is_tile 
    4142   USE phycst         ! physical constants 
    4243   USE stopar         ! Stochastic T/S fluctuations 
     
    189190 
    190191   SUBROUTINE eos_insitu( pts, prd, pdep ) 
     192      !! 
     193      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     194      !                                                      ! 2 : salinity               [psu] 
     195      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
     196      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     197      !! 
     198      CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
     199   END SUBROUTINE eos_insitu 
     200 
     201   SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 
    191202      !!---------------------------------------------------------------------- 
    192203      !!                   ***  ROUTINE eos_insitu  *** 
     
    222233      !!                TEOS-10 Manual, 2010 
    223234      !!---------------------------------------------------------------------- 
    224       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    225       !                                                               ! 2 : salinity               [psu] 
    226       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    227       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     235      INTEGER                                 , INTENT(in   ) ::   ktts, ktrd, ktdep 
     236      REAL(wp), DIMENSION(ST_2DT(ktts) ,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     237      !                                                                  ! 2 : salinity               [psu] 
     238      REAL(wp), DIMENSION(ST_2DT(ktrd) ,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     239      REAL(wp), DIMENSION(ST_2DT(ktdep),jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
    228240      ! 
    229241      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     
    293305      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    294306      ! 
    295    END SUBROUTINE eos_insitu 
     307   END SUBROUTINE eos_insitu_t 
    296308 
    297309 
    298310   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
     311      !! 
     312      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     313      !                                                       ! 2 : salinity               [psu] 
     314      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd    ! in situ density            [-] 
     315      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     316      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
     317      !! 
     318      CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
     319   END SUBROUTINE eos_insitu_pot 
     320 
     321 
     322   SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
    299323      !!---------------------------------------------------------------------- 
    300324      !!                  ***  ROUTINE eos_insitu_pot  *** 
     
    309333      !! 
    310334      !!---------------------------------------------------------------------- 
    311       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    312       !                                                                ! 2 : salinity               [psu] 
    313       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    314       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    315       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     335      INTEGER                                  , INTENT(in   ) ::   ktts, ktrd, ktrhop, ktdep 
     336      REAL(wp), DIMENSION(ST_2DT(ktts)  ,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     337      !                                                                    ! 2 : salinity               [psu] 
     338      REAL(wp), DIMENSION(ST_2DT(ktrd)  ,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     339      REAL(wp), DIMENSION(ST_2DT(ktrhop),jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     340      REAL(wp), DIMENSION(ST_2DT(ktdep) ,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    316341      ! 
    317342      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     
    444469      END SELECT 
    445470      ! 
    446       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
     471      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', & 
     472         &                                  tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 
    447473      ! 
    448474      IF( ln_timing )   CALL timing_stop('eos-pot') 
    449475      ! 
    450    END SUBROUTINE eos_insitu_pot 
     476   END SUBROUTINE eos_insitu_pot_t 
    451477 
    452478 
    453479   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
     480      !! 
     481      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     482      !                                                    ! 2 : salinity               [psu] 
     483      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     484      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prd   ! in situ density 
     485      !! 
     486      CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 
     487   END SUBROUTINE eos_insitu_2d 
     488 
     489 
     490   SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 
    454491      !!---------------------------------------------------------------------- 
    455492      !!                  ***  ROUTINE eos_insitu_2d  *** 
     
    462499      !! 
    463500      !!---------------------------------------------------------------------- 
    464       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    465       !                                                           ! 2 : salinity               [psu] 
    466       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    467       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
     501      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktrd 
     502      REAL(wp), DIMENSION(ST_2DT(ktts),jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     503      !                                                             ! 2 : salinity               [psu] 
     504      REAL(wp), DIMENSION(ST_2DT(ktdep)    ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     505      REAL(wp), DIMENSION(ST_2DT(ktrd)     ), INTENT(  out) ::   prd   ! in situ density 
    468506      ! 
    469507      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     
    535573      IF( ln_timing )   CALL timing_stop('eos2d') 
    536574      ! 
    537    END SUBROUTINE eos_insitu_2d 
     575   END SUBROUTINE eos_insitu_2d_t 
    538576 
    539577 
    540578   SUBROUTINE rab_3d( pts, pab, Kmm ) 
     579      !! 
     580      INTEGER                     , INTENT(in   ) ::   Kmm   ! time level index 
     581      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     582      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     583      !! 
     584      CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
     585   END SUBROUTINE rab_3d 
     586 
     587 
     588   SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 
    541589      !!---------------------------------------------------------------------- 
    542590      !!                 ***  ROUTINE rab_3d  *** 
     
    548596      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
    549597      !!---------------------------------------------------------------------- 
    550       INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    551       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
    552       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     598      INTEGER                                , INTENT(in   ) ::   Kmm   ! time level index 
     599      INTEGER                                , INTENT(in   ) ::   ktts, ktab 
     600      REAL(wp), DIMENSION(ST_2DT(ktts),jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     601      REAL(wp), DIMENSION(ST_2DT(ktab),jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    553602      ! 
    554603      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     
    641690      IF( ln_timing )   CALL timing_stop('rab_3d') 
    642691      ! 
    643    END SUBROUTINE rab_3d 
     692   END SUBROUTINE rab_3d_t 
    644693 
    645694 
    646695   SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 
     696      !! 
     697      INTEGER                   , INTENT(in   ) ::   Kmm   ! time level index 
     698      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     699      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep   ! depth                  [m] 
     700      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     701      !! 
     702      CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 
     703   END SUBROUTINE rab_2d 
     704 
     705 
     706   SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 
    647707      !!---------------------------------------------------------------------- 
    648708      !!                 ***  ROUTINE rab_2d  *** 
     
    652712      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
    653713      !!---------------------------------------------------------------------- 
    654       INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    655       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
    656       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
    657       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     714      INTEGER                            , INTENT(in   ) ::   Kmm   ! time level index 
     715      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktab 
     716      REAL(wp), DIMENSION(ST_2DT(ktts),jpts), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     717      REAL(wp), DIMENSION(ST_2DT(ktdep)    ), INTENT(in   ) ::   pdep   ! depth                  [m] 
     718      REAL(wp), DIMENSION(ST_2DT(ktab),jpts), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
    658719      ! 
    659720      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     
    748809      IF( ln_timing )   CALL timing_stop('rab_2d') 
    749810      ! 
    750    END SUBROUTINE rab_2d 
     811   END SUBROUTINE rab_2d_t 
    751812 
    752813 
     
    849910 
    850911   SUBROUTINE bn2( pts, pab, pn2, Kmm ) 
     912      !! 
     913      INTEGER                              , INTENT(in   ) ::  Kmm   ! time level index 
     914      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     915      REAL(wp), DIMENSION(:,:,:,:)         , INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     916      REAL(wp), DIMENSION(:,:,:)           , INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     917      !! 
     918      CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 
     919   END SUBROUTINE bn2 
     920 
     921 
     922   SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 
    851923      !!---------------------------------------------------------------------- 
    852924      !!                  ***  ROUTINE bn2  *** 
     
    862934      !! 
    863935      !!---------------------------------------------------------------------- 
    864       INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    865       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
    866       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
    867       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     936      INTEGER                                , INTENT(in   ) ::  Kmm   ! time level index 
     937      INTEGER                                , INTENT(in   ) ::  ktab, ktn2 
     938      REAL(wp), DIMENSION(jpi,jpj,  jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     939      REAL(wp), DIMENSION(ST_2DT(ktab),jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     940      REAL(wp), DIMENSION(ST_2DT(ktn2),jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    868941      ! 
    869942      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     
    889962      IF( ln_timing )   CALL timing_stop('bn2') 
    890963      ! 
    891    END SUBROUTINE bn2 
     964   END SUBROUTINE bn2_t 
    892965 
    893966 
     
    9491022 
    9501023 
    951    SUBROUTINE  eos_fzp_2d( psal, ptf, pdep ) 
     1024   SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 
     1025      !! 
     1026      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     1027      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     1028      REAL(wp), DIMENSION(:,:)    , INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1029      !! 
     1030      CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 
     1031   END SUBROUTINE eos_fzp_2d 
     1032 
     1033 
     1034   SUBROUTINE  eos_fzp_2d_t( psal, ptf, kttf, pdep ) 
    9521035      !!---------------------------------------------------------------------- 
    9531036      !!                 ***  ROUTINE eos_fzp  *** 
     
    9611044      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    9621045      !!---------------------------------------------------------------------- 
    963       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    964       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    965       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1046      INTEGER                       , INTENT(in   )           ::   kttf 
     1047      REAL(wp), DIMENSION(jpi,jpj)  , INTENT(in   )           ::   psal   ! salinity   [psu] 
     1048      REAL(wp), DIMENSION(jpi,jpj)  , INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     1049      REAL(wp), DIMENSION(ST_2DT(kttf)), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
    9661050      ! 
    9671051      INTEGER  ::   ji, jj          ! dummy loop indices 
     
    9961080      END SELECT       
    9971081      ! 
    998   END SUBROUTINE eos_fzp_2d 
     1082  END SUBROUTINE eos_fzp_2d_t 
    9991083 
    10001084 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90

    r12377 r13515  
    1717   USE oce            ! ocean dynamics and 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 phycst         ! physical constants 
    2022   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
     
    3739   PUBLIC   tra_ldf        ! called by step.F90  
    3840   PUBLIC   tra_ldf_init   ! called by nemogcm.F90  
    39     
     41 
     42   !! * Substitutions 
     43#  include "do_loop_substitute.h90" 
    4044   !!---------------------------------------------------------------------- 
    4145   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5559      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    5660      !! 
    57       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     61      ! TEMP: This change not necessary after trd_tra is tiled 
     62      INTEGER ::   itile 
     63      INTEGER ::   ji, jj, jk    ! dummy loop indices 
     64      ! TEMP: This change not necessary after trd_tra is tiled 
     65      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     66      ! TEMP: This change not necessary after extra haloes development 
     67      LOGICAL :: lskip 
    5868      !!---------------------------------------------------------------------- 
    5969      ! 
    6070      IF( ln_timing )   CALL timing_start('tra_ldf') 
    6171      ! 
    62       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    63          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    64          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)  
    65          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     72      lskip = .FALSE. 
     73 
     74      IF( l_trdtra ) THEN 
     75         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     76            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     77            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
     78         ENDIF 
    6679      ENDIF 
    67       ! 
    68       SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
    69       CASE ( np_lap   )                                  ! laplacian: iso-level operator 
    70          CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
    71       CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
    72          CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    73       CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    74          CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    75       CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    76          CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    77       END SELECT 
    78       ! 
    79       IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    80          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    81          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    82          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    83          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    84          DEALLOCATE( ztrdt, ztrds )  
     80 
     81      ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
     82      IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it )  THEN 
     83         IF( ln_tile ) THEN 
     84            IF( ntile == 1 ) THEN 
     85               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
     86            ELSE 
     87               lskip = .TRUE. 
     88            ENDIF 
     89         ENDIF 
     90      ENDIF 
     91      IF( .NOT. lskip ) THEN 
     92 
     93         ! TEMP: This change not necessary after trd_tra is tiled 
     94         itile = ntile 
     95 
     96         IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     97            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     98               ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     99               ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 
     100            END_3D 
     101         ENDIF 
     102         ! 
     103         SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
     104         CASE ( np_lap   )                                  ! laplacian: iso-level operator 
     105            CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
     106         CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
     107            CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     108         CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
     109            CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     110         CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
     111            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
     112         END SELECT 
     113         ! 
     114         ! TEMP: These changes not necessary after trd_tra is tiled 
     115         IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
     116            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     117               ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     118               ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 
     119            END_3D 
     120 
     121            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     122               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     123 
     124               ! TODO: TO BE TILED- trd_tra 
     125               CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
     126               CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
     127               DEALLOCATE( ztrdt, ztrds ) 
     128 
     129               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )     ! Revert to tile domain 
     130            ENDIF 
     131         ENDIF 
     132 
     133         ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
     134         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 
     135 
    85136      ENDIF 
    86137      !                                        !* print mean trends (used for debugging) 
    87       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
     138      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask, & 
    88139         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    89140      ! 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90

    r13295 r13515  
    1919   USE oce            ! ocean dynamics and active tracers 
    2020   USE dom_oce        ! ocean space and time domain 
     21   USE domutl, ONLY : is_tile 
    2122   USE trc_oce        ! share passive tracers/Ocean variables 
    2223   USE zdf_oce        ! ocean vertical physics 
     
    4950CONTAINS 
    5051 
    51   SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv,                    & 
    52       &                                            pgu , pgv    ,   pgui, pgvi,   & 
    53       &                                       pt , pt2 , pt_rhs , kjpt  , kpass ) 
     52   SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv,             & 
     53      &                                             pgu , pgv , pgui, pgvi, & 
     54      &                                             pt, pt2, pt_rhs, kjpt, kpass ) 
     55      !! 
     56      INTEGER                     , INTENT(in   ) ::   kt         ! ocean time-step index 
     57      INTEGER                     , INTENT(in   ) ::   kit000     ! first time step index 
     58      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     59      INTEGER                     , INTENT(in   ) ::   kjpt       ! number of tracers 
     60      INTEGER                     , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     61      INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index 
     62      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     63      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     64      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     65      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     66      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     67      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     68      !! 
     69      CALL tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                             & 
     70         &                                         pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui),  & 
     71         &                                         pt, is_tile(pt), pt2, is_tile(pt2), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 
     72   END SUBROUTINE tra_ldf_iso 
     73 
     74 
     75  SUBROUTINE tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah,                    & 
     76      &                                              pgu , pgv , ktg , pgui, pgvi, ktgi,  & 
     77      &                                              pt, ktt, pt2, ktt2, pt_rhs, ktt_rhs, kjpt, kpass ) 
    5478      !!---------------------------------------------------------------------- 
    5579      !!                  ***  ROUTINE tra_ldf_iso  *** 
     
    92116      !! ** Action :   Update pt_rhs arrays with the before rotated diffusion 
    93117      !!---------------------------------------------------------------------- 
    94       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    95       INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    96       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    97       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    98       INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    99       INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level index 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    101       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    102       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    105       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
     118      INTEGER                                   , INTENT(in   ) ::   kt         ! ocean time-step index 
     119      INTEGER                                   , INTENT(in   ) ::   kit000     ! first time step index 
     120      CHARACTER(len=3)                          , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     121      INTEGER                                   , INTENT(in   ) ::   kjpt       ! number of tracers 
     122      INTEGER                                   , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     123      INTEGER                                   , INTENT(in   ) ::   Kmm        ! ocean time level index 
     124      INTEGER                                   , INTENT(in   ) ::   ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 
     125      REAL(wp), DIMENSION(ST_2DT(ktah)   ,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     126      REAL(wp), DIMENSION(ST_2DT(ktg)        ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     127      REAL(wp), DIMENSION(ST_2DT(ktgi)       ,kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     128      REAL(wp), DIMENSION(ST_2DT(ktt)    ,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     129      REAL(wp), DIMENSION(ST_2DT(ktt2)   ,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     130      REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    106131      ! 
    107132      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     
    111136      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    112137      REAL(wp) ::  zcoef0, ze3w_2, zsign                 !   -      - 
    113       REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
    114       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
     138      REAL(wp), DIMENSION(ST_2D(nn_hls))     ::   zdkt, zdk1t, z2d 
     139      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   zdit, zdjt, zftu, zftv, ztfw 
    115140      !!---------------------------------------------------------------------- 
    116141      ! 
    117142      IF( kpass == 1 .AND. kt == kit000 )  THEN 
    118          IF(lwp) WRITE(numout,*) 
    119          IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    120          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    121          ! 
    122          akz     (:,:,:) = 0._wp       
    123          ah_wslp2(:,:,:) = 0._wp 
     143         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     144            IF(lwp) WRITE(numout,*) 
     145            IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
     146            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     147         ENDIF 
     148         ! 
     149         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     150            akz     (ji,jj,jk) = 0._wp 
     151            ah_wslp2(ji,jj,jk) = 0._wp 
     152         END_3D 
    124153      ENDIF 
    125       !    
    126       l_hst = .FALSE. 
    127       l_ptr = .FALSE. 
    128       IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE.  
    129       IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    130          &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     154      ! 
     155      IF( ntile == 0 .OR. ntile == 1 )  THEN                           ! Do only on the first tile 
     156         l_hst = .FALSE. 
     157         l_ptr = .FALSE. 
     158         IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE. 
     159         IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     160            &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     161      ENDIF 
    131162      ! 
    132163      ! 
     
    167198            ! 
    168199            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    169                DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
    170                   akz(ji,jj,jk) = 16._wp   & 
    171                      &   * ah_wslp2   (ji,jj,jk)   & 
    172                      &   * (  akz     (ji,jj,jk)   & 
    173                      &      + ah_wslp2(ji,jj,jk)   & 
    174                      &        / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  ) 
     200               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     201                  akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
     202                     &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  ) 
    175203               END_3D 
    176204            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    177                DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
     205               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    178206                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    179207                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     
    183211           ! 
    184212         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    185             akz(:,:,:) = ah_wslp2(:,:,:)       
     213            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     214               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
     215            END_3D 
    186216         ENDIF 
    187217      ENDIF 
     
    195225         !!---------------------------------------------------------------------- 
    196226!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    197          zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
    198          zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
     227         zdit (ntsi-nn_hls,:,:) = 0._wp     ;     zdit (ntei+nn_hls,:,:) = 0._wp 
     228         zdjt (ntsi-nn_hls,:,:) = 0._wp     ;     zdjt (ntei+nn_hls,:,:) = 0._wp 
    199229         !!end 
    200230 
     
    204234            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    205235         END_3D 
     236         ! TODO: NOT TESTED- requires zps 
    206237         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    207238            DO_2D( 1, 0, 1, 0 ) 
     
    209240               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    210241            END_2D 
     242            ! TODO: NOT TESTED- requires isf 
    211243            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    212244               DO_2D( 1, 0, 1, 0 ) 
     
    223255         DO jk = 1, jpkm1                                 ! Horizontal slab 
    224256            ! 
    225             !                             !== Vertical tracer gradient 
    226             zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    227             ! 
    228             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    229             ELSE                 ;   zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 
    230             ENDIF 
     257            DO_2D( 1, 1, 1, 1 ) 
     258               !                             !== Vertical tracer gradient 
     259               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
     260               ! 
     261               IF( jk == 1 ) THEN   ;   zdkt(ji,jj) = zdk1t(ji,jj)                            ! surface: zdkt(jk=1)=zdkt(jk=2) 
     262               ELSE                 ;   zdkt(ji,jj) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     263               ENDIF 
     264            END_2D 
     265            ! 
    231266            DO_2D( 1, 0, 1, 0 ) 
    232267               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     
    330365      END DO                                                      ! end tracer loop 
    331366      ! 
    332    END SUBROUTINE tra_ldf_iso 
     367   END SUBROUTINE tra_ldf_iso_t 
    333368 
    334369   !!============================================================================== 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90

    r13295 r13515  
    1313   USE oce            ! ocean dynamics and active tracers 
    1414   USE dom_oce        ! ocean space and time domain 
     15   USE domutl, ONLY : is_tile 
    1516   USE ldftra         ! lateral physics: eddy diffusivity 
    1617   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine) 
     
    4647CONTAINS 
    4748 
    48    SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv  ,               & 
    49       &                                             pgu , pgv   , pgui, pgvi,   & 
    50       &                                             pt  , pt_rhs, kjpt, kpass )  
     49   SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv,             & 
     50      &                                             pgu , pgv , pgui, pgvi, & 
     51      &                                             pt, pt_rhs, kjpt, kpass ) 
     52      !! 
     53      INTEGER                     , INTENT(in   ) ::   kt         ! ocean time-step index 
     54      INTEGER                     , INTENT(in   ) ::   kit000     ! first time step index 
     55      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     56      INTEGER                     , INTENT(in   ) ::   kjpt       ! number of tracers 
     57      INTEGER                     , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     58      INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index 
     59      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     60      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     61      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     62      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! before tracer fields 
     63      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     64      !! 
     65      CALL tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                            & 
     66      &                                            pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), & 
     67      &                                            pt, is_tile(pt), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 
     68   END SUBROUTINE tra_ldf_lap 
     69 
     70 
     71   SUBROUTINE tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah,                   & 
     72      &                                               pgu , pgv , ktg , pgui, pgvi, ktgi, & 
     73      &                                               pt, ktt, pt_rhs, ktt_rhs, kjpt, kpass ) 
    5174      !!---------------------------------------------------------------------- 
    5275      !!                  ***  ROUTINE tra_ldf_lap  *** 
     
    7295      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    7396      INTEGER                              , INTENT(in   ) ::   Kmm        ! ocean time level index 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    75       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    76       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! before tracer fields 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend  
     97      INTEGER                              , INTENT(in   ) ::   ktah, ktg, ktgi, ktt, ktt_rhs 
     98      REAL(wp), DIMENSION(ST_2DT(ktah),   jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     99      REAL(wp), DIMENSION(ST_2DT(ktg),        kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     100      REAL(wp), DIMENSION(ST_2DT(ktgi),       kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     101      REAL(wp), DIMENSION(ST_2DT(ktt),    jpk,kjpt), INTENT(in   ) ::   pt         ! before tracer fields 
     102      REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    79103      ! 
    80104      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    81105      REAL(wp) ::   zsign            ! local scalars 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zaheeu, zaheev 
    83       !!---------------------------------------------------------------------- 
    84       ! 
    85       IF( kt == nit000 .AND. lwp )  THEN 
    86          WRITE(numout,*) 
    87          WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 
    88          WRITE(numout,*) '~~~~~~~~~~~ ' 
    89       ENDIF 
    90       ! 
    91       l_hst = .FALSE. 
    92       l_ptr = .FALSE. 
    93       IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     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. 
     106      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) ::   ztu, ztv, zaheeu, zaheev 
     107      !!---------------------------------------------------------------------- 
     108      ! 
     109      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     110         IF( kt == nit000 .AND. lwp )  THEN 
     111            WRITE(numout,*) 
     112            WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 
     113            WRITE(numout,*) '~~~~~~~~~~~ ' 
     114         ENDIF 
     115         ! 
     116         l_hst = .FALSE. 
     117         l_ptr = .FALSE. 
     118         IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE. 
     119         IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     120            &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     121      ENDIF 
    96122      ! 
    97123      !                                !==  Initialization of metric arrays used for all tracers  ==! 
     
    112138            ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
    113139         END_3D 
     140         ! TODO: NOT TESTED- requires zps 
    114141         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level 
    115142            DO_2D( 1, 0, 1, 0 ) 
     
    117144               ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 
    118145            END_2D 
     146            ! TODO: NOT TESTED- requires isf 
    119147            IF( ln_isfcav ) THEN                ! top in ocean cavities only 
    120148               DO_2D( 1, 0, 1, 0 ) 
     
    142170      !                             ! ================== 
    143171      ! 
    144    END SUBROUTINE tra_ldf_lap 
     172   END SUBROUTINE tra_ldf_lap_t 
    145173    
    146174 
     
    173201      ! 
    174202      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    175       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap         ! laplacian at t-point 
    176       REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
    177       REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
     203      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,kjpt) :: zlap         ! laplacian at t-point 
     204      REAL(wp), DIMENSION(ST_2D(nn_hls),    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
     205      REAL(wp), DIMENSION(ST_2D(nn_hls),    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
    178206      !!--------------------------------------------------------------------- 
    179207      ! 
    180       IF( kt == kit000 .AND. lwp )  THEN 
    181          WRITE(numout,*) 
    182          SELECT CASE ( kldf ) 
    183          CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype 
    184          CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)' 
    185          CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)' 
    186          END SELECT 
    187          WRITE(numout,*) '~~~~~~~~~~~' 
     208      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     209         IF( kt == kit000 .AND. lwp )  THEN 
     210            WRITE(numout,*) 
     211            SELECT CASE ( kldf ) 
     212            CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype 
     213            CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)' 
     214            CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)' 
     215            END SELECT 
     216            WRITE(numout,*) '~~~~~~~~~~~' 
     217         ENDIF 
    188218      ENDIF 
    189219 
     
    202232      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    203233      !                                               ! Partial top/bottom cell: GRADh( zlap )   
     234      ! TODO: NOT TESTED- requires zps and isf 
    204235      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
    205236      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom  
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90

    r13295 r13515  
    1313   USE oce            ! ocean dynamics and active tracers 
    1414   USE dom_oce        ! ocean space and time domain 
     15   ! TEMP: This change not necessary if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 
     16   USE domain, ONLY : dom_tile 
     17   USE domutl, ONLY : is_tile 
    1518   USE phycst         ! physical constants 
    1619   USE trc_oce        ! share passive tracers/Ocean variables 
     
    3336   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90 
    3437 
    35    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels 
    36  
    3738   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
    3839   LOGICAL  ::   l_hst   ! flag to compute heat transport 
     
    4950CONTAINS 
    5051 
    51   SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv,               & 
    52       &                                              pgu , pgv  , pgui, pgvi , & 
    53       &                                         pt , pt2, pt_rhs, kjpt, kpass ) 
     52   SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv,             & 
     53      &                                               pgu , pgv , pgui, pgvi, & 
     54      &                                               pt, pt2, pt_rhs, kjpt, kpass ) 
     55      !! 
     56      INTEGER                     , INTENT(in   ) ::   kt         ! ocean time-step index 
     57      INTEGER                     , INTENT(in   ) ::   kit000     ! first time step index 
     58      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     59      INTEGER                     , INTENT(in   ) ::   kjpt       ! number of tracers 
     60      INTEGER                     , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     61      INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level indices 
     62      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     63      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
     64      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     65      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     66      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     67      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt_rhs     ! tracer trend 
     68      !! 
     69      CALL tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu),                            & 
     70      &                                              pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), & 
     71      &                                              pt, is_tile(pt), pt2, is_tile(pt2), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 
     72   END SUBROUTINE tra_ldf_triad 
     73 
     74 
     75  SUBROUTINE tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah,                   & 
     76      &                                                pgu , pgv , ktg , pgui, pgvi, ktgi, & 
     77      &                                                pt, ktt, pt2, ktt2, pt_rhs, ktt_rhs, kjpt, kpass ) 
    5478      !!---------------------------------------------------------------------- 
    5579      !!                  ***  ROUTINE tra_ldf_triad  *** 
     
    77101      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    78102      INTEGER                              , INTENT(in)    ::   Kmm        ! ocean time level indices 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    80       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
    81       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
     103      INTEGER                              , INTENT(in   ) ::   ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 
     104      REAL(wp), DIMENSION(ST_2DT(ktah),   jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     105      REAL(wp), DIMENSION(ST_2DT(ktg),        kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
     106      REAL(wp), DIMENSION(ST_2DT(ktgi),       kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
     107      REAL(wp), DIMENSION(ST_2DT(ktt),    jpk,kjpt), INTENT(in   ) ::   pt         ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     108      REAL(wp), DIMENSION(ST_2DT(ktt2),   jpk,kjpt), INTENT(in   ) ::   pt2        ! tracer (only used in kpass=2) 
     109      REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    85110      ! 
    86111      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     
    94119      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    95120      REAL(wp) ::   zah, zah_slp, zaei_slp 
    96       REAL(wp), DIMENSION(jpi,jpj    ) ::   z2d                                              ! 2D workspace 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
     121      REAL(wp), DIMENSION(ST_2D(nn_hls),0:1)     ::   zdkt3d                         ! vertical tracer gradient at 2 levels 
     122      REAL(wp), DIMENSION(ST_2D(nn_hls)        ) ::   z2d                            ! 2D workspace 
     123      REAL(wp), DIMENSION(ST_2D(nn_hls)    ,jpk) ::   zdit, zdjt, zftu, zftv, ztfw   ! 3D     - 
     124      ! TEMP: This can be ST_2D(nn_hls) if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 
     125      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
    98126      !!---------------------------------------------------------------------- 
    99127      ! 
    100       IF( .NOT.ALLOCATED(zdkt3d) )  THEN 
    101          ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr ) 
    102          CALL mpp_sum ( 'traldf_triad', ierr ) 
    103          IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays') 
    104       ENDIF 
    105      ! 
    106       IF( kpass == 1 .AND. kt == kit000 )  THEN 
    107          IF(lwp) WRITE(numout,*) 
    108          IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 
    109          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    110       ENDIF 
    111       !    
    112       l_hst = .FALSE. 
    113       l_ptr = .FALSE. 
    114       IF( cdtype == 'TRA' ) THEN 
    115          IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf') )      l_ptr = .TRUE.  
    116          IF( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.                   & 
    117          &   iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  )   l_hst = .TRUE. 
     128      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     129         IF( kpass == 1 .AND. kt == kit000 )  THEN 
     130            IF(lwp) WRITE(numout,*) 
     131            IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 
     132            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
     133         ENDIF 
     134         ! 
     135         l_hst = .FALSE. 
     136         l_ptr = .FALSE. 
     137         IF( cdtype == 'TRA' ) THEN 
     138            IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf') )      l_ptr = .TRUE. 
     139            IF( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.                   & 
     140            &   iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  )   l_hst = .TRUE. 
     141         ENDIF 
    118142      ENDIF 
    119143      ! 
     
    128152      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
    129153         ! 
    130          akz     (:,:,:) = 0._wp       
    131          ah_wslp2(:,:,:) = 0._wp 
    132          IF( ln_ldfeiv_dia ) THEN 
    133             zpsi_uw(:,:,:) = 0._wp 
    134             zpsi_vw(:,:,:) = 0._wp 
    135          ENDIF 
     154         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     155            akz     (ji,jj,jk) = 0._wp 
     156            ah_wslp2(ji,jj,jk) = 0._wp 
     157         END_3D 
    136158         ! 
    137159         DO ip = 0, 1                            ! i-k triads 
    138160            DO kp = 0, 1 
    139                DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    140                   ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 
    141                   zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    142                   zah   = 0.25_wp * pahu(ji,jj,jk) 
    143                   zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
     161               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     162                  ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     163                  zbu   = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) 
     164                  zah   = 0.25_wp * pahu(ji-ip,jj,jk) 
     165                  zslope_skew = triadi_g(ji,jj,jk,1-ip,kp) 
    144166                  ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
    145                   zslope2 = zslope_skew + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     167                  zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 
    146168                  zslope2 = zslope2 *zslope2 
    147                   ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 
    148                   akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       & 
    149                      &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     169                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 
     170                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj)       & 
     171                     &                                                      * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 
    150172                     ! 
    151                  IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   & 
    152                      &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew 
    153173               END_3D 
    154174            END DO 
     
    157177         DO jp = 0, 1                            ! j-k triads  
    158178            DO kp = 0, 1 
    159                DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    160                   ze3wr = 1.0_wp / e3w(ji,jj+jp,jk+kp,Kmm) 
    161                   zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    162                   zah   = 0.25_wp * pahv(ji,jj,jk) 
    163                   zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
     179               DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     180                  ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
     181                  zbv   = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) 
     182                  zah   = 0.25_wp * pahv(ji,jj-jp,jk) 
     183                  zslope_skew = triadj_g(ji,jj,jk,1-jp,kp) 
    164184                  ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    165185                  !    (do this by *adding* gradient of depth) 
    166                   zslope2 = zslope_skew + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     186                  zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 
    167187                  zslope2 = zslope2 * zslope2 
    168                   ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 
    169                   akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     & 
    170                      &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     188                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 
     189                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp)     & 
     190                     &                                                      * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 
    171191                  ! 
    172                   IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   & 
    173                      &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew 
    174192               END_3D 
    175193            END DO 
     
    179197            ! 
    180198            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    181                DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
    182                   akz(ji,jj,jk) = 16._wp           & 
    183                      &   * ah_wslp2   (ji,jj,jk)   & 
    184                      &   * (  akz     (ji,jj,jk)   & 
    185                      &      + ah_wslp2(ji,jj,jk)   & 
    186                      &        / ( e3w (ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  ) 
     199               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     200                  akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
     201                     &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) )  ) 
    187202               END_3D 
    188203            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    189                DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
     204               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    190205                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    191206                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     
    195210           ! 
    196211         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    197             akz(:,:,:) = ah_wslp2(:,:,:)       
    198          ENDIF 
    199          ! 
    200          IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
     212            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     213               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
     214            END_3D 
     215         ENDIF 
     216         ! 
     217         ! TEMP: These changes not necessary if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 
     218         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     219            IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 
     220               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
     221 
     222               zpsi_uw(:,:,:) = 0._wp 
     223               zpsi_vw(:,:,:) = 0._wp 
     224 
     225               DO jp = 0, 1 
     226                  DO kp = 0, 1 
     227                     DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     228                        zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 
     229                           & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 
     230                        zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 
     231                           & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 
     232                     END_3D 
     233                  END DO 
     234               END DO 
     235               CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
     236 
     237               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) 
     238            ENDIF 
     239         ENDIF 
    201240         ! 
    202241      ENDIF                                  !==  end 1st pass only  ==! 
     
    215254            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    216255         END_3D 
     256         ! TODO: NOT TESTED- requires zps 
    217257         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
    218258            DO_2D( 1, 0, 1, 0 ) 
     
    220260               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    221261            END_2D 
     262            ! TODO: NOT TESTED- requires isf 
    222263            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    223264               DO_2D( 1, 0, 1, 0 ) 
     
    234275         DO jk = 1, jpkm1 
    235276            !                    !==  Vertical tracer gradient at level jk and jk+1 
    236             zdkt3d(:,:,1) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
     277            DO_2D( 1, 1, 1, 1 ) 
     278               zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
     279            END_2D 
    237280            ! 
    238281            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 
    239282            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    240             ELSE                 ;   zdkt3d(:,:,0) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk) 
     283            ELSE 
     284               DO_2D( 1, 1, 1, 1 ) 
     285                  zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     286               END_2D 
    241287            ENDIF 
    242288            ! 
     
    380426      END DO                                                      ! end tracer loop 
    381427      !                                                           ! =============== 
    382    END SUBROUTINE tra_ldf_triad 
     428   END SUBROUTINE tra_ldf_triad_t 
    383429 
    384430   !!============================================================================== 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90

    r13295 r13515  
    1717   USE oce             ! ocean: dynamics and tracers variables 
    1818   USE dom_oce         ! domain: ocean variables 
     19   USE domutl, ONLY : is_tile 
    1920   USE phycst          ! physical constants 
    2021   USE eosbn2          ! ocean equation of state 
     
    4041CONTAINS 
    4142 
    42    SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv,   & 
    43       &                          prd, pgru, pgrv    ) 
     43   ! TODO: NOT TESTED- requires zps 
     44   SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv,  & 
     45      &                               prd, pgru, pgrv ) 
     46      !! 
     47      INTEGER                     , INTENT(in   )           ::  kt          ! ocean time-step index 
     48      INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index 
     49      INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers 
     50      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta         ! 4D tracers fields 
     51      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
     52      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     53      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
     54      ! 
     55      INTEGER :: itrd, itgr 
     56      !! 
     57      IF( PRESENT(prd)  ) THEN ; itrd = is_tile(prd)  ; ELSE ; itrd = 0 ; ENDIF 
     58      IF( PRESENT(pgru) ) THEN ; itgr = is_tile(pgru) ; ELSE ; itgr = 0 ; ENDIF 
     59 
     60      CALL zps_hde_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), & 
     61         &                           prd, itrd,         pgru, pgrv, itgr ) 
     62   END SUBROUTINE zps_hde 
     63 
     64 
     65   SUBROUTINE zps_hde_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt,   & 
     66      &                                 prd, ktrd, pgru, pgrv, ktgr ) 
    4467      !!---------------------------------------------------------------------- 
    4568      !!                     ***  ROUTINE zps_hde  *** 
     
    85108      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 
    86109      !!---------------------------------------------------------------------- 
    87       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    88       INTEGER                              , INTENT(in   )           ::  Kmm         ! ocean time level index 
    89       INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    90       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    91       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
    92       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    93       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
     110      INTEGER                                , INTENT(in   )           ::  kt          ! ocean time-step index 
     111      INTEGER                                , INTENT(in   )           ::  Kmm         ! ocean time level index 
     112      INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers 
     113      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr 
     114      REAL(wp), DIMENSION(ST_2DT(ktta),jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
     115      REAL(wp), DIMENSION(ST_2DT(ktgt)    ,kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
     116      REAL(wp), DIMENSION(ST_2DT(ktrd),jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     117      REAL(wp), DIMENSION(ST_2DT(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    94118      ! 
    95119      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices 
    96120      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points 
    97121      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars 
    98       REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
    99       REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             !  
     122      REAL(wp), DIMENSION(ST_2D(nn_hls))      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     123      REAL(wp), DIMENSION(ST_2D(nn_hls),kjpt) ::   zti, ztj             ! 
    100124      !!---------------------------------------------------------------------- 
    101125      ! 
     
    185209      IF( ln_timing )   CALL timing_stop( 'zps_hde') 
    186210      ! 
    187    END SUBROUTINE zps_hde 
    188  
    189  
     211   END SUBROUTINE zps_hde_t 
     212 
     213 
     214   ! TODO: NOT TESTED- requires zps 
    190215   SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
    191       &                          prd, pgru, pgrv, pgrui, pgrvi ) 
     216      &                                   prd, pgru, pgrv, pgrui, pgrvi ) 
     217      !! 
     218      INTEGER                     , INTENT(in   )           ::  kt           ! ocean time-step index 
     219      INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index 
     220      INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers 
     221      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta          ! 4D tracers fields 
     222      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
     223      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
     224      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
     225      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
     226      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
     227      ! 
     228      INTEGER :: itrd, itgr, itgri 
     229      !! 
     230      IF( PRESENT(prd)   ) THEN ; itrd  = is_tile(prd)   ; ELSE ; itrd  = 0 ; ENDIF 
     231      IF( PRESENT(pgru)  ) THEN ; itgr  = is_tile(pgru)  ; ELSE ; itgr  = 0 ; ENDIF 
     232      IF( PRESENT(pgrui) ) THEN ; itgri = is_tile(pgrui) ; ELSE ; itgri = 0 ; ENDIF 
     233 
     234      CALL zps_hde_isf_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), pgtui, pgtvi, is_tile(pgtui),  & 
     235      &                                  prd, itrd,         pgru, pgrv, itgr,          pgrui, pgrvi, itgri ) 
     236   END SUBROUTINE zps_hde_isf 
     237 
     238 
     239   SUBROUTINE zps_hde_isf_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt, pgtui, pgtvi, ktgti,  & 
     240      &                                     prd, ktrd, pgru, pgrv, ktgr, pgrui, pgrvi, ktgri ) 
    192241      !!---------------------------------------------------------------------- 
    193242      !!                     ***  ROUTINE zps_hde_isf  *** 
     
    236285      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 
    237286      !!---------------------------------------------------------------------- 
    238       INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index 
    239       INTEGER                              , INTENT(in   )           ::  Kmm          ! ocean time level index 
    240       INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers 
    241       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields 
    242       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts  
    243       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
    244       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
    245       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
    246       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
     287      INTEGER                                , INTENT(in   )           ::  kt           ! ocean time-step index 
     288      INTEGER                                , INTENT(in   )           ::  Kmm          ! ocean time level index 
     289      INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers 
     290      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri 
     291      REAL(wp), DIMENSION(ST_2DT(ktta),jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields 
     292      REAL(wp), DIMENSION(ST_2DT(ktgt)    ,kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
     293      REAL(wp), DIMENSION(ST_2DT(ktgti)   ,kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
     294      REAL(wp), DIMENSION(ST_2DT(ktrd),jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
     295      REAL(wp), DIMENSION(ST_2DT(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
     296      REAL(wp), DIMENSION(ST_2DT(ktgri)        ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    247297      ! 
    248298      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    249299      INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points 
    250300      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv             ! temporary scalars 
    251       REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
    252       REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
     301      REAL(wp), DIMENSION(ST_2D(nn_hls))      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     302      REAL(wp), DIMENSION(ST_2D(nn_hls),kjpt) ::  zti, ztj             ! 
    253303      !!---------------------------------------------------------------------- 
    254304      ! 
     
    440490      IF( ln_timing )   CALL timing_stop( 'zps_hde_isf') 
    441491      ! 
    442    END SUBROUTINE zps_hde_isf 
     492   END SUBROUTINE zps_hde_isf_t 
    443493 
    444494   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.