Changeset 13518


Ignore:
Timestamp:
2020-09-24T20:49:07+02:00 (5 months ago)
Author:
hadcv
Message:

Tiling for modules before tra_adv

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

Legend:

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

    r13295 r13518  
    520520      INTEGER  :: it 
    521521      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    522       REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values 
     522      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 
    523523      !!---------------------------------------------------------------------- 
    524524      ! 
    525525      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
    526526      ! used to prevent the applied increments taking the temperature below the local freezing point  
    527       DO jk = 1, jpkm1 
    528         CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
    529       END DO 
     527      ! TODO: NOT TESTED- logical is forced to False 
     528      IF( ln_temnofreeze ) THEN 
     529         DO jk = 1, jpkm1 
     530           CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
     531         END DO 
     532      ENDIF 
    530533         ! 
    531534         !                             !-------------------------------------- 
     
    538541            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    539542            ! 
    540             IF(lwp) THEN 
    541                WRITE(numout,*)  
    542                WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    543                WRITE(numout,*) '~~~~~~~~~~~~' 
     543            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     544               IF(lwp) THEN 
     545                  WRITE(numout,*) 
     546                  WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
     547                  WRITE(numout,*) '~~~~~~~~~~~~' 
     548               ENDIF 
    544549            ENDIF 
    545550            ! 
    546551            ! Update the tracer tendencies 
     552            ! TODO: NOT TESTED- logical is forced to False 
    547553            DO jk = 1, jpkm1 
    548554               IF (ln_temnofreeze) THEN 
    549555                  ! Do not apply negative increments if the temperature will fall below freezing 
    550                   WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 
    551                      &   pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )  
    552                      pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     556                  WHERE(t_bkginc(ST_2D(0),jk) > 0.0_wp .OR. & 
     557                     &   pts(ST_2D(0),jk,jp_tem,Kmm) + pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
     558                     pts(ST_2D(0),jk,jp_tem,Krhs) = pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * zincwgt 
    553559                  END WHERE 
    554560               ELSE 
    555                   pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     561                  DO_2D( 0, 0, 0, 0 ) 
     562                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 
     563                  END_2D 
    556564               ENDIF 
    557565               IF (ln_salfix) THEN 
    558566                  ! Do not apply negative increments if the salinity will fall below a specified 
    559567                  ! minimum value salfixmin 
    560                   WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 
    561                      &   pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )  
    562                      pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 
     568                  WHERE(s_bkginc(ST_2D(0),jk) > 0.0_wp .OR. & 
     569                     &   pts(ST_2D(0),jk,jp_sal,Kmm) + pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * wgtiau(it) > salfixmin ) 
     570                     pts(ST_2D(0),jk,jp_sal,Krhs) = pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * zincwgt 
    563571                  END WHERE 
    564572               ELSE 
    565                   pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 
     573                  DO_2D( 0, 0, 0, 0 ) 
     574                     pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 
     575                  END_2D 
    566576               ENDIF 
    567577            END DO 
     
    569579         ENDIF 
    570580         ! 
    571          IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
    572             DEALLOCATE( t_bkginc ) 
    573             DEALLOCATE( s_bkginc ) 
     581         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     582            IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
     583               DEALLOCATE( t_bkginc ) 
     584               DEALLOCATE( s_bkginc ) 
     585            ENDIF 
    574586         ENDIF 
    575587         !                             !-------------------------------------- 
     
    582594            ! 
    583595            ! Initialize the now fields with the background + increment 
     596            ! TODO: NOT TESTED- logical is forced to False 
    584597            IF (ln_temnofreeze) THEN 
    585598               ! Do not apply negative increments if the temperature will fall below freezing 
    586                WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
    587                   pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     599               WHERE( t_bkginc(ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_tem,Kmm) + t_bkginc(ST_2D(0),:) > fzptnz(:,:,:) ) 
     600                  pts(ST_2D(0),:,jp_tem,Kmm) = t_bkg(ST_2D(0),:) + t_bkginc(ST_2D(0),:) 
    588601               END WHERE 
    589602            ELSE 
    590                pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     603               DO_3D( 0, 0, 0, 0, 1, jpk ) 
     604                  pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 
     605               END_3D 
    591606            ENDIF 
    592607            IF (ln_salfix) THEN 
    593608               ! Do not apply negative increments if the salinity will fall below a specified 
    594609               ! minimum value salfixmin 
    595                WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )  
    596                   pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
     610               WHERE( s_bkginc(ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_sal,Kmm) + s_bkginc(ST_2D(0),:) > salfixmin ) 
     611                  pts(ST_2D(0),:,jp_sal,Kmm) = s_bkg(ST_2D(0),:) + s_bkginc(ST_2D(0),:) 
    597612               END WHERE 
    598613            ELSE 
    599                pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    600             ENDIF 
    601  
    602             pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm)                 ! Update before fields 
     614               DO_3D( 0, 0, 0, 0, 1, jpk ) 
     615                  pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 
     616               END_3D 
     617            ENDIF 
     618 
     619            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     620               pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm)             ! Update before fields 
     621            END_3D 
    603622 
    604623            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
     
    607626!!gm 
    608627 
    609             IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
    610                &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
    611                &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
    612             IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
    613                &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
    614                &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
    615  
    616             DEALLOCATE( t_bkginc ) 
    617             DEALLOCATE( s_bkginc ) 
    618             DEALLOCATE( t_bkg    ) 
    619             DEALLOCATE( s_bkg    ) 
     628            ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 
     629            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     630               IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
     631                  &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
     632                  &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
     633               IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
     634                  &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
     635                  &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
     636            ENDIF 
     637 
     638            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     639               DEALLOCATE( t_bkginc ) 
     640               DEALLOCATE( s_bkginc ) 
     641               DEALLOCATE( t_bkg    ) 
     642               DEALLOCATE( s_bkg    ) 
     643            ENDIF 
     644         ! 
    620645         ENDIF 
    621646         !   
    622647      ENDIF 
     648      ! TODO: NOT TESTED- logical is forced to False 
    623649      ! Perhaps the following call should be in step 
    624650      IF ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment 
     
    829855      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation 
    830856      ! 
     857      INTEGER  ::   ji, jj 
    831858      INTEGER  ::   it 
    832859      REAL(wp) ::   zincwgt   ! IAU weight for current time step 
    833860#if defined key_si3 
    834       REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc 
     861      REAL(wp), DIMENSION(ST_2D(nn_hls)) ::   zofrld, zohicif, zseaicendg, zhicifinc 
    835862      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres 
    836863#endif 
     
    847874            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 
    848875            ! 
    849             IF(lwp) THEN 
    850                WRITE(numout,*)  
    851                WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    852                WRITE(numout,*) '~~~~~~~~~~~~' 
     876            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     877               IF(lwp) THEN 
     878                  WRITE(numout,*) 
     879                  WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
     880                  WRITE(numout,*) '~~~~~~~~~~~~' 
     881               ENDIF 
    853882            ENDIF 
    854883            ! 
     
    856885            ! 
    857886#if defined key_si3 
    858             zofrld (:,:) = 1._wp - at_i(:,:) 
    859             zohicif(:,:) = hm_i(:,:) 
    860             ! 
    861             at_i  (:,:) = 1. - MIN( MAX( 1.-at_i  (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    862             at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    863             fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
    864             ! 
    865             zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
     887            DO_2D( 0, 0, 0, 0 ) 
     888               zofrld (ji,jj) = 1._wp - at_i(ji,jj) 
     889               zohicif(ji,jj) = hm_i(ji,jj) 
     890               ! 
     891               at_i  (ji,jj) = 1. - MIN( MAX( 1.-at_i  (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 
     892               at_i_b(ji,jj) = 1. - MIN( MAX( 1.-at_i_b(ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 
     893               fr_i(ji,jj) = at_i(ji,jj)        ! adjust ice fraction 
     894               ! 
     895               zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj))   ! find out actual sea ice nudge applied 
     896            END_2D 
    866897            ! 
    867898            ! Nudge sea ice depth to bring it up to a required minimum depth 
    868             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
    869                zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt     
     899            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 
     900               zhicifinc(:,:) = (zhicifmin - hm_i(ST_2D(0))) * zincwgt 
    870901            ELSEWHERE 
    871902               zhicifinc(:,:) = 0.0_wp 
     
    873904            ! 
    874905            ! nudge ice depth 
    875             hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
     906            DO_2D( 0, 0, 0, 0 ) 
     907               hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 
     908            END_2D 
    876909            ! 
    877910            ! seaice salinity balancing (to add) 
     
    880913#if defined key_cice && defined key_asminc 
    881914            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    882             ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 
    883 #endif 
    884             ! 
    885             IF ( kt == nitiaufin_r ) THEN 
    886                DEALLOCATE( seaice_bkginc ) 
     915            DO_2D( 0, 0, 0, 0 ) 
     916               ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 
     917            END_2D 
     918#endif 
     919            ! 
     920            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     921               IF ( kt == nitiaufin_r ) THEN 
     922                  DEALLOCATE( seaice_bkginc ) 
     923               ENDIF 
    887924            ENDIF 
    888925            ! 
     
    890927            ! 
    891928#if defined key_cice && defined key_asminc 
    892             ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     929            DO_2D( 0, 0, 0, 0 ) 
     930               ndaice_da(ji,jj) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     931            END_2D 
    893932#endif 
    894933            ! 
     
    905944            ! 
    906945#if defined key_si3 
    907             zofrld (:,:) = 1._wp - at_i(:,:) 
    908             zohicif(:,:) = hm_i(:,:) 
    909             !  
    910             ! Initialize the now fields the background + increment 
    911             at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
    912             at_i_b(:,:) = at_i(:,:)  
    913             fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
    914             ! 
    915             zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
     946            DO_2D( 0, 0, 0, 0 ) 
     947               zofrld (ji,jj) = 1._wp - at_i(ji,jj) 
     948               zohicif(ji,jj) = hm_i(ji,jj) 
     949               ! 
     950               ! Initialize the now fields the background + increment 
     951               at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 
     952               at_i_b(ji,jj) = at_i(ji,jj) 
     953               fr_i(ji,jj) = at_i(ji,jj)        ! adjust ice fraction 
     954               ! 
     955               zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj))   ! find out actual sea ice nudge applied 
     956            END_2D 
    916957            ! 
    917958            ! Nudge sea ice depth to bring it up to a required minimum depth 
    918             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
    919                zhicifinc(:,:) = zhicifmin - hm_i(:,:) 
     959            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 
     960               zhicifinc(:,:) = zhicifmin - hm_i(ST_2D(0)) 
    920961            ELSEWHERE 
    921962               zhicifinc(:,:) = 0.0_wp 
     
    923964            ! 
    924965            ! nudge ice depth 
    925             hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
     966            DO_2D( 0, 0, 0, 0 ) 
     967               hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 
     968            END_2D 
    926969            ! 
    927970            ! seaice salinity balancing (to add) 
     
    930973#if defined key_cice && defined key_asminc 
    931974            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    932            ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 
    933 #endif 
    934             IF ( .NOT. PRESENT(kindic) ) THEN 
    935                DEALLOCATE( seaice_bkginc ) 
    936             END IF 
     975            DO_2D( 0, 0, 0, 0 ) 
     976               ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 
     977            END_2D 
     978#endif 
     979            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     980               IF ( .NOT. PRESENT(kindic) ) THEN 
     981                  DEALLOCATE( seaice_bkginc ) 
     982               END IF 
     983            ENDIF 
    937984            ! 
    938985         ELSE 
    939986            ! 
    940987#if defined key_cice && defined key_asminc 
    941             ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     988            DO_2D( 0, 0, 0, 0 ) 
     989               ndaice_da(ji,jj) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     990            END_2D 
    942991#endif 
    943992            ! 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/BDY/bdytra.F90

    r13226 r13518  
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce            ! ocean dynamics and tracers variables 
    15    USE dom_oce        ! ocean space and time domain variables  
     15   USE dom_oce        ! ocean space and time domain variables 
    1616   USE bdy_oce        ! ocean open boundary conditions 
    1717   USE bdylib         ! for orlanski library routines 
     
    157157      INTEGER  ::   ib_bdy         ! Loop index 
    158158      !!---------------------------------------------------------------------- 
     159      ! TODO: TO BE TILED 
     160      ! TODO: NOT TESTED- requires bdy 
     161      ! NOTE: Tiling these BDY loops is nontrivial; IF statements to check whether a point is in the current tile won't work (will be for every ib, every tile). The idx_bdy structure might require modifying to include a %nblen and list of ib indices for the current tile. 
     162      IF( ntile /= 0 .AND. ntile /= 1 ) RETURN                        ! Do only for the full domain 
    159163      ! 
    160164      IF( ln_timing )   CALL timing_start('bdy_tra_dmp') 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/dtatsd.F90

    r13295 r13518  
    1818   USE phycst          ! physical constants 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE domain, ONLY : dom_tile 
    2021   USE fldread         ! read input fields 
    2122   ! 
     
    135136      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt 
    136137      !!---------------------------------------------------------------------- 
    137       INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
    138       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
     138      INTEGER                          , INTENT(in   ) ::   kt     ! ocean time-step 
     139      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    139140      ! 
    140141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
     
    144145      !!---------------------------------------------------------------------- 
    145146      ! 
    146       CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
     147      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     148         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     149            CALL fld_read( kt, 1, sf_tsd )   !==   read T & S data at kt time step   ==! 
    147150      ! 
    148151      ! 
    149152!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed 
    150       ! 
    151       !                                   !==   ORCA_R2 configuration and T & S damping   ==!  
    152       IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    153          IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations 
    154             ! 
    155             ij0 = 101 + nn_hls       ;   ij1 = 109 + nn_hls                       ! Reduced T & S in the Alboran Sea 
    156             ii0 = 141 + nn_hls - 1   ;   ii1 = 155 + nn_hls - 1 
    157             DO jj = mj0(ij0), mj1(ij1) 
    158                DO ji = mi0(ii0), mi1(ii1) 
    159                   sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 
    160                   sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 
    161                   sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 
    162                   ! 
    163                   sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 
    164                   sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 
    165                   sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 
    166                   sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 
     153         ! 
     154         !                                   !==   ORCA_R2 configuration and T & S damping   ==! 
     155         ! TODO: NOT TESTED- requires orca2 
     156         IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
     157            IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations 
     158               ! 
     159               ij0 = 101 + nn_hls       ;   ij1 = 109 + nn_hls                       ! Reduced T & S in the Alboran Sea 
     160               ii0 = 141 + nn_hls - 1   ;   ii1 = 155 + nn_hls - 1 
     161               DO jj = mj0(ij0), mj1(ij1) 
     162                  DO ji = mi0(ii0), mi1(ii1) 
     163                     sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 
     164                     sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 
     165                     sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 
     166                     ! 
     167                     sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 
     168                     sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 
     169                     sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 
     170                     sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 
     171                  END DO 
    167172               END DO 
    168             END DO 
    169             ij0 =  87 + nn_hls       ;   ij1 =  96 + nn_hls                       ! Reduced temperature in Red Sea 
    170             ii0 = 148 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
    171             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp 
    172             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 
    173             sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
    174          ENDIF 
    175       ENDIF 
     173               ij0 =  87 + nn_hls       ;   ij1 =  96 + nn_hls                       ! Reduced temperature in Red Sea 
     174               ii0 = 148 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
     175               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp 
     176               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 
     177               sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
     178            ENDIF 
     179         ENDIF 
    176180!!gm end 
    177       ! 
    178       ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
    179       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
     181         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )            ! Revert to tile domain 
     182      ENDIF 
     183      ! 
     184      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     185         ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     186         ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 
     187      END_3D 
    180188      ! 
    181189      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    182190         ! 
    183          IF( kt == nit000 .AND. lwp )THEN 
    184             WRITE(numout,*) 
    185             WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     191         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     192            IF( kt == nit000 .AND. lwp )THEN 
     193               WRITE(numout,*) 
     194               WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     195            ENDIF 
    186196         ENDIF 
    187197         ! 
     
    215225      ELSE                                !==   z- or zps- coordinate   ==! 
    216226         !                              
    217          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    218          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
    219          ! 
     227         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     228            ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
     229            ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     230         END_3D 
     231         ! 
     232         ! TODO: NOT TESTED- requires zps 
    220233         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    221234            DO_2D( 1, 1, 1, 1 ) 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbc.F90

    r13295 r13518  
    1717   USE oce            ! ocean variables 
    1818   USE dom_oce        ! domain: ocean 
     19   ! TEMP: This change not necessary after trd_tra is tiled 
     20   USE domain, ONLY : dom_tile 
    1921   USE phycst         ! physical constants 
    2022   USE trd_oce        ! trends: ocean variables 
     
    8082      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    8183      ! 
    82       INTEGER  ::   ji, jj    ! dummy loop indices 
    83       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
     84      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     85      ! TEMP: This change not necessary after trd_tra is tiled 
     86      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
    8487      !!---------------------------------------------------------------------- 
    8588      ! 
    8689      IF( ln_timing )   CALL timing_start('tra_bbc') 
    8790      ! 
    88       IF( l_trdtra )   THEN         ! Save the input temperature trend 
    89          ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    90          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     91      IF( l_trdtra ) THEN           ! Save the input temperature trend 
     92         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     93            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     94            ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
     95         ENDIF 
     96 
     97         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     98            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     99         END_3D 
    91100      ENDIF 
    92101      !                             !  Add the geothermal trend on temperature 
     
    96105      END_2D 
    97106      ! 
    98       CALL lbc_lnk( 'trabbc', pts(:,:,:,jp_tem,Krhs) , 'T', 1.0_wp ) 
    99       ! 
    100       IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
    101          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    102          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    103          DEALLOCATE( ztrdt ) 
    104       ENDIF 
    105       ! 
    106       CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 
    107       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
     107      ! TEMP: These changes not necessary after trd_tra is tiled, lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes) 
     108      IF( l_trdtra ) THEN 
     109         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     110            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     111         END_3D 
     112      ENDIF 
     113 
     114      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     115         ! 
     116         IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
     117            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     118 
     119            ! TODO: TO BE TILED- trd_tra 
     120            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
     121            DEALLOCATE( ztrdt ) 
     122 
     123            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     124         ENDIF 
     125         ! 
     126         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 
     127      ENDIF 
     128 
     129      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, & 
     130         &                                  clinfo3='tra-ta' ) 
    108131      ! 
    109132      IF( ln_timing )   CALL timing_stop('tra_bbc') 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90

    r13295 r13518  
    2626   USE oce            ! ocean dynamics and active tracers 
    2727   USE dom_oce        ! ocean space and time domain 
     28   ! TEMP: This change not necessary after trd_tra is tiled 
     29   USE domain, ONLY : dom_tile 
    2830   USE phycst         ! physical constant 
    2931   USE eosbn2         ! equation of state 
     
    106108      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation 
    107109      ! 
    108       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     110      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
     111      ! TEMP: This change not necessary after trd_tra is tiled 
     112      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    109113      !!---------------------------------------------------------------------- 
    110114      ! 
     
    112116      ! 
    113117      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    114          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    115          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    116          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     118         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     119            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     120            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
     121         ENDIF 
     122 
     123         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     124            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     125            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 
     126         END_3D 
    117127      ENDIF 
    118128 
     
    125135         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    126136            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    127          ! lateral boundary conditions ; just need for outputs 
    128          CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 
    129          CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    130          CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
     137         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     138            ! lateral boundary conditions ; just need for outputs 
     139            CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1.0_wp , ahv_bbl, 'V', 1.0_wp ) 
     140            CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
     141            CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
     142         ENDIF 
    131143         ! 
    132144      ENDIF 
     
    136148         CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 
    137149         IF(sn_cfctl%l_prtctl)   & 
    138          CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
     150         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, & 
    139151            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    140          ! lateral boundary conditions ; just need for outputs 
    141          CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    142          CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    143          CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    144          ! 
    145       ENDIF 
    146  
     152         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     153            ! lateral boundary conditions ; just need for outputs 
     154            CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
     155            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
     156            CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
     157         ENDIF 
     158         ! 
     159      ENDIF 
     160 
     161      ! TEMP: These changes not necessary after trd_tra is tiled 
    147162      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    148          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    149          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    150          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    151          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    152          DEALLOCATE( ztrdt, ztrds ) 
     163         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     164            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     165            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 
     166         END_3D 
     167 
     168         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     169            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     170 
     171            ! TODO: TO BE TILED- trd_tra 
     172            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
     173            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 
     174            DEALLOCATE( ztrdt, ztrds ) 
     175 
     176            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     177         ENDIF 
    153178      ENDIF 
    154179      ! 
     
    187212      INTEGER  ::   ik           ! local integers 
    188213      REAL(wp) ::   zbtr         ! local scalars 
    189       REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace 
     214      REAL(wp), DIMENSION(ST_2D(nn_hls)) ::   zptb   ! workspace 
    190215      !!---------------------------------------------------------------------- 
    191216      ! 
     
    242267      DO jn = 1, kjpt                                            ! tracer loop 
    243268         !                                                       ! =========== 
    244          DO jj = 1, jpjm1 
    245             DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    246                IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    247                   ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
    248                   iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
    249                   ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj) 
    250                   zu_bbl = ABS( utr_bbl(ji,jj) ) 
    251                   ! 
    252                   !                                               ! up  -slope T-point (shelf bottom point) 
    253                   zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 
    254                   ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
    255                   pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
    256                   ! 
    257                   DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    258                      zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 
    259                      ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
    260                      pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
    261                   END DO 
    262                   ! 
    263                   zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 
    264                   ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
    265                   pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
    266                ENDIF 
    267                ! 
    268                IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection 
    269                   ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf) 
    270                   ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
    271                   ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj) 
    272                   zv_bbl = ABS( vtr_bbl(ji,jj) ) 
    273                   ! 
    274                   ! up  -slope T-point (shelf bottom point) 
    275                   zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 
    276                   ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
    277                   pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
    278                   ! 
    279                   DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    280                      zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 
    281                      ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
    282                      pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
    283                   END DO 
    284                   !                                               ! down-slope T-point (deep bottom point) 
    285                   zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 
    286                   ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
    287                   pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
    288                ENDIF 
    289             END DO 
     269         DO_2D( 1, 0, 1, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
     270            IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
     271               ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
     272               iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
     273               ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj) 
     274               zu_bbl = ABS( utr_bbl(ji,jj) ) 
     275               ! 
     276               !                                               ! up  -slope T-point (shelf bottom point) 
     277               zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 
     278               ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
     279               pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
     280               ! 
     281               DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
     282                  zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 
     283                  ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
     284                  pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
     285               END DO 
     286               ! 
     287               zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 
     288               ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
     289               pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
     290            ENDIF 
    290291            ! 
    291          END DO 
    292          !                                                  ! =========== 
    293       END DO                                                ! end tracer 
    294       !                                                     ! =========== 
     292            IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection 
     293               ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf) 
     294               ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
     295               ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj) 
     296               zv_bbl = ABS( vtr_bbl(ji,jj) ) 
     297               ! 
     298               ! up  -slope T-point (shelf bottom point) 
     299               zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 
     300               ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
     301               pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
     302               ! 
     303               DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
     304                  zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 
     305                  ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
     306                  pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
     307               END DO 
     308               !                                               ! down-slope T-point (deep bottom point) 
     309               zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 
     310               ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
     311               pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
     312            ENDIF 
     313         END_2D 
     314         !                                                       ! =========== 
     315      END DO                                                     ! end tracer 
     316      !                                                          ! =========== 
    295317   END SUBROUTINE tra_bbl_adv 
    296318 
     
    333355      REAL(wp) ::   za, zb, zgdrho            ! local scalars 
    334356      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      - 
    335       REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace 
    336       REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace 
    337       !!---------------------------------------------------------------------- 
    338       ! 
    339       IF( kt == kit000 )  THEN 
    340          IF(lwp)  WRITE(numout,*) 
    341          IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 
    342          IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
     357      REAL(wp), DIMENSION(ST_2D(nn_hls),jpts)   :: zts, zab         ! 3D workspace 
     358      REAL(wp), DIMENSION(ST_2D(nn_hls))        :: zub, zvb, zdep   ! 2D workspace 
     359      !!---------------------------------------------------------------------- 
     360      ! 
     361      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     362         IF( kt == kit000 )  THEN 
     363            IF(lwp)  WRITE(numout,*) 
     364            IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 
     365            IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
     366         ENDIF 
    343367      ENDIF 
    344368      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tradmp.F90

    r13295 r13518  
    2424   USE oce            ! ocean: variables 
    2525   USE dom_oce        ! ocean: domain variables 
     26   ! TEMP: This change not necessary after trd_tra is tiled 
     27   USE domain, ONLY : dom_tile 
    2628   USE c1d            ! 1D vertical configuration 
    2729   USE trd_oce        ! trends: ocean variables 
     
    9597      ! 
    9698      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
    98       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
     99      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts)     ::  zts_dta 
     100      ! TEMP: This change not necessary after trd_tra is tiled 
     101      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::  ztrdts 
    99102      !!---------------------------------------------------------------------- 
    100103      ! 
     
    102105      ! 
    103106      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    104          ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    105          ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)  
     107         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     108            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     109            ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
     110         ENDIF 
     111 
     112         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     113            ztrdts(ji,jj,jk,:) = pts(ji,jj,jk,:,Krhs) 
     114         END_3D 
    106115      ENDIF 
    107116      !                           !==  input T-S data at kt  ==! 
     
    140149      END SELECT 
    141150      ! 
     151      ! TEMP: These changes not necessary after trd_tra is tiled 
    142152      IF( l_trdtra )   THEN       ! trend diagnostic 
    143          ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:) 
    144          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    145          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
    146          DEALLOCATE( ztrdts )  
     153         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     154            ztrdts(ji,jj,jk,:) = pts(ji,jj,jk,:,Krhs) - ztrdts(ji,jj,jk,:) 
     155         END_3D 
     156 
     157         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     158            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     159 
     160            ! TODO: TO BE TILED- trd_tra 
     161            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
     162            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
     163            DEALLOCATE( ztrdts ) 
     164 
     165            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     166         ENDIF 
    147167      ENDIF 
    148168      !                           ! Control print 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traisf.F90

    r13295 r13518  
    1111   !!---------------------------------------------------------------------- 
    1212   USE isf_oce                                     ! Ice shelf variables 
     13   USE par_oce , ONLY : nijtile, ntile, ntsi, ntei, ntsj, ntej 
    1314   USE dom_oce                                     ! ocean space domain variables 
    1415   USE isfutils, ONLY : debug                      ! debug option 
     
    3132CONTAINS 
    3233 
     34   ! TODO: NOT TESTED- requires isf 
    3335   SUBROUTINE tra_isf ( kt, Kmm, pts, Krhs ) 
    3436      !!---------------------------------------------------------------------- 
     
    4648      IF( ln_timing )   CALL timing_start('tra_isf') 
    4749      ! 
    48       IF( kt == nit000 ) THEN 
    49          IF(lwp) WRITE(numout,*) 
    50          IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes' 
    51          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     50      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     51         IF( kt == nit000 ) THEN 
     52            IF(lwp) WRITE(numout,*) 
     53            IF(lwp) WRITE(numout,*) 'tra_isf : Ice shelf heat fluxes' 
     54            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     55         ENDIF 
    5256      ENDIF 
    5357      ! 
     
    7680      ! 
    7781      IF ( ln_isfdebug ) THEN 
    78          CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 
    79          CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 
     82         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only for the full domain 
     83            CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 
     84            CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 
     85         ENDIF 
    8086      END IF 
    8187      ! 
     
    8490   END SUBROUTINE tra_isf 
    8591   ! 
     92   ! TODO: NOT TESTED- requires isf 
    8693   SUBROUTINE tra_isf_mlt(ktop, kbot, phtbl, pfrac, ptsc, ptsc_b, pts) 
    8794      !!---------------------------------------------------------------------- 
     
    101108      INTEGER                      :: ji,jj,jk  ! loop index    
    102109      INTEGER                      :: ikt, ikb  ! top and bottom level of the tbl 
    103       REAL(wp), DIMENSION(jpi,jpj) :: ztc       ! total ice shelf tracer trend 
     110      REAL(wp), DIMENSION(ST_2D(nn_hls))    :: ztc       ! total ice shelf tracer trend 
    104111      !!---------------------------------------------------------------------- 
    105112      ! 
    106113      ! compute 2d total trend due to isf 
    107       ztc(:,:) = 0.5_wp * ( ptsc(:,:,jp_tem) + ptsc_b(:,:,jp_tem) ) / phtbl(:,:) 
     114      DO_2D( 1, 1, 1, 1 ) 
     115         ztc(ji,jj) = 0.5_wp * ( ptsc(ji,jj,jp_tem) + ptsc_b(ji,jj,jp_tem) ) / phtbl(ji,jj) 
     116      END_2D 
    108117      ! 
    109118      ! update pts(:,:,:,:,Krhs) 
     
    125134   END SUBROUTINE tra_isf_mlt 
    126135   ! 
     136   ! TODO: NOT TESTED- requires isf 
    127137   SUBROUTINE tra_isf_cpl( Kmm, ptsc, ptsa ) 
    128138      !!---------------------------------------------------------------------- 
     
    137147      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) :: ptsc 
    138148      !!---------------------------------------------------------------------- 
    139       INTEGER :: jk 
     149      INTEGER :: ji, jj, jk 
    140150      !!---------------------------------------------------------------------- 
    141151      ! 
    142       DO jk = 1,jpk 
    143          ptsa(:,:,jk,jp_tem) =   & 
    144             &  ptsa(:,:,jk,jp_tem) + ptsc(:,:,jk,jp_tem) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 
    145          ptsa(:,:,jk,jp_sal) =   & 
    146             &  ptsa(:,:,jk,jp_sal) + ptsc(:,:,jk,jp_sal) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 
    147       END DO 
     152      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     153         ptsa(ji,jj,jk,jp_tem) = ptsa(ji,jj,jk,jp_tem) + ptsc(ji,jj,jk,jp_tem) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     154         ptsa(ji,jj,jk,jp_sal) = ptsa(ji,jj,jk,jp_sal) + ptsc(ji,jj,jk,jp_sal) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     155      END_3D 
    148156      ! 
    149157   END SUBROUTINE tra_isf_cpl 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90

    r13333 r13518  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain 
     24   USE domain, ONLY : dom_tile 
    2425   USE sbc_oce        ! surface boundary condition: ocean 
    2526   USE trc_oce        ! share SMS/Ocean variables 
     
    114115      REAL(wp) ::   zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze 
    115116      REAL(wp) ::   zlogc, zlogze, zlogCtot, zlogCze 
     117      ! TEMP: These changes not necessary after trd_tra is tiled 
     118      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztrdt 
    116119      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: ze0, ze1, ze2, ze3 
    117120      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d 
     
    120123      IF( ln_timing )   CALL timing_start('tra_qsr') 
    121124      ! 
    122       IF( kt == nit000 ) THEN 
    123          IF(lwp) WRITE(numout,*) 
    124          IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 
    125          IF(lwp) WRITE(numout,*) '~~~~~~~' 
     125      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     126         IF( kt == nit000 ) THEN 
     127            IF(lwp) WRITE(numout,*) 
     128            IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 
     129            IF(lwp) WRITE(numout,*) '~~~~~~~' 
     130         ENDIF 
    126131      ENDIF 
    127132      ! 
    128133      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129          ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    130          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     134         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     135            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     136            ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
     137         ENDIF 
     138 
     139         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     140            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     141         END_3D 
    131142      ENDIF 
    132143      ! 
     
    136147      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    137148         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    138             IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
    139149            z1_2 = 0.5_wp 
    140             CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux 
     150            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     151               IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
     152               CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux 
     153            ENDIF 
    141154         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    142155            z1_2 = 1._wp 
    143             qsr_hc_b(:,:,:) = 0._wp 
     156            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     157               qsr_hc_b(ji,jj,jk) = 0._wp 
     158            END_3D 
    144159         ENDIF 
    145160      ELSE                             !==  Swap of qsr heat content  ==! 
    146161         z1_2 = 0.5_wp 
    147          qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 
     162         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     163            qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
     164         END_3D 
    148165      ENDIF 
    149166      ! 
     
    154171      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    155172         ! 
    156          DO jk = 1, nksr 
    157             qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
    158          END DO 
     173         DO_3D( 0, 0, 0, 0, 1, nksr ) 
     174            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
     175         END_3D 
    159176         ! 
    160177      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    161178         ! 
    162          ALLOCATE( ze0 (jpi,jpj)           , ze1 (jpi,jpj) ,   & 
    163             &      ze2 (jpi,jpj)           , ze3 (jpi,jpj) ,   & 
    164             &      ztmp3d(jpi,jpj,nksr + 1)                     ) 
     179         ALLOCATE( ze0 (ST_2D(nn_hls))           , ze1 (ST_2D(nn_hls)) ,   & 
     180            &      ze2 (ST_2D(nn_hls))           , ze3 (ST_2D(nn_hls)) ,   & 
     181            &      ztmp3d(ST_2D(nn_hls),nksr + 1)                     ) 
    165182         ! 
    166183         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    167             CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
     184            IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     185               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     186               CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
     187               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )            ! Revert to tile domain 
     188            ENDIF 
    168189            ! 
    169190            ! Separation in R-G-B depending on the surface Chl 
     
    215236            ! Convert chlorophyll value to attenuation coefficient look-up table index 
    216237            zlui = 41 + 20.*LOG10(zchl) + 1.e-15 
    217             DO jk = 1, nksr + 1 
    218                ztmp3d(:,:,jk) = zlui  
    219             END DO 
     238            DO_3D( 1, 1, 1, 1, 1, nksr + 1 ) 
     239               ztmp3d(ji,jj,jk) = zlui 
     240            END_3D 
    220241         ENDIF 
    221242         ! 
     
    277298         ENDIF 
    278299      END_2D 
    279       CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 
    280       ! 
    281       IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
    282          ALLOCATE( zetot(jpi,jpj,jpk) ) 
    283          zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    284          DO jk = nksr, 1, -1 
    285             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 
    286          END DO          
    287          CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    288          DEALLOCATE( zetot )  
    289       ENDIF 
    290       ! 
    291       IF( lrst_oce ) THEN     ! write in the ocean restart file 
    292          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    293          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc     , ldxios = lwxios ) 
    294          CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios )  
    295          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    296       ENDIF 
    297       ! 
     300      ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed) 
     301      IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     302         CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 
     303      ENDIF 
     304      ! 
     305      ! TEMP: This change not necessary and working array can use ST_2D(nn_hls) if using XIOS (subdomain support) 
     306      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     307         IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
     308            ALLOCATE( zetot(jpi,jpj,jpk) ) 
     309            zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
     310            DO jk = nksr, 1, -1 
     311               zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 
     312            END DO 
     313            CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
     314            DEALLOCATE( zetot ) 
     315         ENDIF 
     316      ENDIF 
     317      ! 
     318      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     319         IF( lrst_oce ) THEN     ! write in the ocean restart file 
     320            IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
     321            CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc     , ldxios = lwxios ) 
     322            CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 
     323            IF( lwxios ) CALL iom_swap(      cxios_context          ) 
     324         ENDIF 
     325      ENDIF 
     326      ! 
     327      ! TEMP: These changes not necessary after trd_tra is tiled 
    298328      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    299          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    300          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    301          DEALLOCATE( ztrdt )  
     329         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     330            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     331         END_3D 
     332 
     333         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     334            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     335 
     336            ! TODO: TO BE TILED- trd_tra 
     337            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
     338            DEALLOCATE( ztrdt ) 
     339 
     340            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     341         ENDIF 
    302342      ENDIF 
    303343      !                       ! print mean trends (used for debugging) 
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trasbc.F90

    r13295 r13518  
    1919   USE sbc_oce        ! surface boundary condition: ocean 
    2020   USE dom_oce        ! ocean space domain variables 
     21   ! TEMP: This change not necessary after trd_tra is tiled 
     22   USE domain, ONLY : dom_tile 
    2123   USE phycst         ! physical constant 
    2224   USE eosbn2         ! Equation Of State 
     
    7981      INTEGER  ::   ikt, ikb                    ! local integers 
    8082      REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar 
    81       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     83      ! TEMP: This change not necessary after trd_tra is tiled 
     84      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    8285      !!---------------------------------------------------------------------- 
    8386      ! 
    8487      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8588      ! 
    86       IF( kt == nit000 ) THEN 
    87          IF(lwp) WRITE(numout,*) 
    88          IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 
    89          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     89      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     90         IF( kt == nit000 ) THEN 
     91            IF(lwp) WRITE(numout,*) 
     92            IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 
     93            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     94         ENDIF 
    9095      ENDIF 
    9196      ! 
    9297      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    93          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    94          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
    95          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     98         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     99            ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 
     100            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
     101         ENDIF 
     102 
     103         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     104            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 
     105            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 
     106         END_3D 
    96107      ENDIF 
    97108      ! 
    98109!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    99110      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    100          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    101          qsr(:,:) = 0._wp                     ! qsr set to zero 
     111         DO_2D( 0, 0, 0, 0 ) 
     112            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
     113            qsr(ji,jj) = 0._wp                        ! qsr set to zero 
     114         END_2D 
    102115      ENDIF 
    103116 
     
    109122         IF( ln_rstart .AND.    &               ! Restart: read in restart file 
    110123              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
    111             IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file' 
    112124            zfact = 0.5_wp 
    113             sbc_tsc(:,:,:) = 0._wp 
    114             CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend 
    115             CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend 
     125            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     126               IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file' 
     127               sbc_tsc(:,:,:) = 0._wp 
     128               CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend 
     129               CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend 
     130            ENDIF 
    116131         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    117132            zfact = 1._wp 
    118             sbc_tsc(:,:,:) = 0._wp 
    119             sbc_tsc_b(:,:,:) = 0._wp 
     133            DO_2D( 0, 0, 0, 0 ) 
     134               sbc_tsc(ji,jj,:) = 0._wp 
     135               sbc_tsc_b(ji,jj,:) = 0._wp 
     136            END_2D 
    120137         ENDIF 
    121138      ELSE                                !* other time-steps: swap of forcing fields 
    122139         zfact = 0.5_wp 
    123          sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
     140         DO_2D( 0, 0, 0, 0 ) 
     141            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 
     142         END_2D 
    124143      ENDIF 
    125144      !                             !==  Now sbc tracer content fields  ==! 
    126       DO_2D( 0, 1, 0, 0 ) 
     145      DO_2D( 0, 0, 0, 0 ) 
    127146         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    128147         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    129148      END_2D 
    130149      IF( ln_linssh ) THEN                !* linear free surface   
    131          DO_2D( 0, 1, 0, 0 ) 
     150         DO_2D( 0, 0, 0, 0 ) 
    132151            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    133152            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
    134153         END_2D 
    135          IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
    136          IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
     154         IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile 
     155            IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
     156            IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
     157         ENDIF 
    137158      ENDIF 
    138159      ! 
    139160      DO jn = 1, jpts               !==  update tracer trend  ==! 
    140          DO_2D( 0, 1, 0, 0 ) 
    141             pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) )    & 
    142                &                                                / e3t(ji,jj,1,Kmm) 
     161         DO_2D( 0, 0, 0, 0 ) 
     162            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm) 
    143163         END_2D 
    144164      END DO 
    145165      !                   
    146       IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
    147          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    148          CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios ) 
    149          CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios ) 
    150          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
     166      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     167         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
     168            IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
     169            CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios ) 
     170            CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios ) 
     171            IF( lwxios ) CALL iom_swap(      cxios_context          ) 
     172         ENDIF 
    151173      ENDIF 
    152174      ! 
     
    157179      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff  
    158180         zfact = 0.5_wp 
    159          DO_2D( 0, 1, 0, 0 ) 
     181         DO_2D( 0, 0, 0, 0 ) 
    160182            IF( rnf(ji,jj) /= 0._wp ) THEN 
    161183               zdep = zfact / h_rnf(ji,jj) 
     
    170192      ENDIF 
    171193 
    172       IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
    173       IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
     194      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     195         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
     196         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
     197      ENDIF 
    174198 
    175199#if defined key_asminc 
     
    182206          ! 
    183207         IF( ln_linssh ) THEN  
    184             DO_2D( 0, 1, 0, 0 ) 
     208            DO_2D( 0, 0, 0, 0 ) 
    185209               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 
    186210               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim 
     
    188212            END_2D 
    189213         ELSE 
    190             DO_2D( 0, 1, 0, 0 ) 
     214            DO_2D( 0, 0, 0, 0 ) 
    191215               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 
    192216               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim 
     
    199223#endif 
    200224      ! 
     225      ! TEMP: These changes not necessary after trd_tra is tiled 
    201226      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    202          ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    203          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    204          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    205          CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    206          DEALLOCATE( ztrdt , ztrds )  
     227         DO_3D( 0, 0, 0, 0, 1, jpk ) 
     228            ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 
     229            ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 
     230         END_3D 
     231 
     232         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     233            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
     234 
     235            ! TODO: TO BE TILED- trd_tra 
     236            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
     237            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 
     238            DEALLOCATE( ztrdt , ztrds ) 
     239 
     240            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     241         ENDIF 
    207242      ENDIF 
    208243      ! 
Note: See TracChangeset for help on using the changeset viewer.