Changeset 12765


Ignore:
Timestamp:
2020-04-17T14:45:04+02:00 (6 months ago)
Author:
hadcv
Message:

tra_ldf_iso trial using public variables

Location:
NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/cfgs/SHARED/namelist_ref

    r12530 r12765  
    9494   ln_use_jattr = .false.    !  use (T) the file attribute: open_ocean_jstart, if present 
    9595   !                         !  in netcdf input files, as the start j-row for reading 
     96/ 
     97!----------------------------------------------------------------------- 
     98&namtile        !   parameters of the tiling 
     99!----------------------------------------------------------------------- 
     100   ln_tile = .false.     !  Use tiling (T) or not (F) 
     101   nn_tile_i = 10        !  Length of tiles in i 
     102   nn_tile_j = 10        !  Length of tiles in j 
    96103/ 
    97104!----------------------------------------------------------------------- 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/DOM/dom_oce.F90

    r12489 r12765  
    7272   !                                !  = 7 bi-cyclic East-West AND North-South 
    7373   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity  
     74 
     75   ! Tiling namelist 
     76   LOGICAL, PUBLIC ::   ln_tile 
     77   INTEGER         ::   nn_tile_i, nn_tile_j 
    7478 
    7579   !                                 !  domain MPP decomposition parameters 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/DOM/domain.F90

    r12489 r12765  
    4949 
    5050   PUBLIC   dom_init     ! called by nemogcm.F90 
     51   PUBLIC   dom_tile     ! called by step.F90 
    5152   PUBLIC   domain_cfg   ! called by nemogcm.F90 
    5253 
     
    122123      CALL dom_glo                     ! global domain versus local domain 
    123124      CALL dom_nam                     ! read namelist ( namrun, namdom ) 
     125 
     126      ! Initialise tile to full domain 
     127      CALL dom_tile(0) 
     128 
    124129      ! 
    125130      IF( lwxios ) THEN 
     
    270275 
    271276 
     277   SUBROUTINE dom_tile(kntile) 
     278      !!---------------------------------------------------------------------- 
     279      !!                     ***  ROUTINE dom_tile  *** 
     280      !! 
     281      !! ** Purpose :   Set domain indices for specified tile 
     282      !! 
     283      !! ** Action  : - ntile          : current tile number 
     284      !!              - ntsi, ntsj     : start of internal part of domain 
     285      !!              - ntei, ntej     : end of internal part of domain 
     286      !!              - ntsim1, ntsjm1 : start of domain 
     287      !!              - nteip1, ntejp1 : end of domain 
     288      !!---------------------------------------------------------------------- 
     289      INTEGER   , INTENT(in ) :: kntile               ! Tile number 
     290      INTEGER                 :: iitile, ijtile       ! Tile number in i and j 
     291      !!---------------------------------------------------------------------- 
     292 
     293      IF( ln_tile .AND. kntile > 0 ) THEN          ! Tile domain 
     294         iitile = 1 + MOD( kntile - 1, jpnitile ) 
     295         ijtile = 1 + (kntile - 1) / jpnitile 
     296 
     297         ntile = kntile 
     298         ntsi = 2 + (iitile - 1) * nn_tile_i 
     299         ntsj = 2 + (ijtile - 1) * nn_tile_j 
     300         ntei = MIN(ntsi + nn_tile_i - 1, jpim1)   ! Size of last tile limited by full domain 
     301         ntej = MIN(ntsj + nn_tile_j - 1, jpjm1)   ! 
     302         ntsim1 = ntsi - 1 
     303         ntsjm1 = ntsj - 1 
     304         nteip1 = ntei + 1 
     305         ntejp1 = ntej + 1 
     306      ELSE                                         ! Full domain 
     307         ntile = 1 
     308         ntsi = 2 
     309         ntsj = 2 
     310         ntei = jpim1 
     311         ntej = jpjm1 
     312         ntsim1 = 1 
     313         ntsjm1 = 1 
     314         nteip1 = jpi 
     315         ntejp1 = jpj 
     316      ENDIF 
     317   END SUBROUTINE dom_tile 
     318 
     319 
    272320   SUBROUTINE dom_nam 
    273321      !!---------------------------------------------------------------------- 
     
    278326      !! ** input   : - namrun namelist 
    279327      !!              - namdom namelist 
     328      !!              - namtile namelist 
    280329      !!              - namnc4 namelist   ! "key_netcdf4" only 
    281330      !!---------------------------------------------------------------------- 
     
    290339         &             ln_cfmeta, ln_xios_read, nn_wxios 
    291340      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 
     341      NAMELIST/namtile/ ln_tile, nn_tile_i, nn_tile_j 
    292342#if defined key_netcdf4 
    293343      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
     
    417467      r1_Dt = 1._wp / rDt 
    418468 
     469      READ  ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 
     470905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtile in reference namelist' ) 
     471      READ  ( numnam_cfg, namtile, IOSTAT = ios, ERR = 906 ) 
     472906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtile in configuration namelist' ) 
     473      IF(lwm) WRITE( numond, namtile ) 
     474 
     475      ! Set tile decomposition 
     476      IF( ln_tile ) THEN 
     477         jpnitile = (jpi - 2) / nn_tile_i 
     478         jpnjtile = (jpj - 2) / nn_tile_j 
     479         IF( MOD( jpi - 2, nn_tile_i ) /= 0 ) jpnitile = jpnitile + 1 
     480         IF( MOD( jpj - 2, nn_tile_j ) /= 0 ) jpnjtile = jpnjtile + 1 
     481      ELSE 
     482         jpnitile = 1 
     483         jpnjtile = 1 
     484      ENDIF 
     485      jpnijtile = jpnitile * jpnjtile 
     486 
     487      IF(lwp) THEN 
     488         WRITE(numout,*) 
     489         WRITE(numout,*)    '   Namelist : namtile   ---   tiling decomposition' 
     490         WRITE(numout,*)    '      Tiling (T) or not (F)                ln_tile   = ', ln_tile 
     491         WRITE(numout,*)    '      Length of tile in i                  nn_tile_i = ', nn_tile_i 
     492         WRITE(numout,*)    '      Length of tile in j                  nn_tile_j = ', nn_tile_j 
     493         WRITE(numout,*) 
     494         IF( ln_tile ) THEN 
     495            WRITE(numout,*) '      The domain will be decomposed into', jpnijtile, 'tiles of size', nn_tile_i, 'x', nn_tile_j 
     496         ELSE 
     497            WRITE(numout,*) '      Domain tiling will NOT be used' 
     498         ENDIF 
     499      ENDIF 
     500 
    419501      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    420502         lrxios = ln_xios_read.AND.ln_rstart 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/TRA/traldf.F90

    r12377 r12765  
    4545CONTAINS 
    4646 
    47    SUBROUTINE tra_ldf( kt, Kbb, Kmm, pts, Krhs ) 
     47   SUBROUTINE tra_ldf(kt, Kbb, Kmm, pts, Krhs ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE tra_ldf  *** 
     
    5858      !!---------------------------------------------------------------------- 
    5959      ! 
    60       IF( ln_timing )   CALL timing_start('tra_ldf') 
     60      IF( ntile == 1 )  THEN                      ! Do only on the first tile 
     61         ! TODO: TO BE TILED 
     62         IF( ln_timing )   CALL timing_start('tra_ldf') 
     63      ENDIF 
    6164      ! 
    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) 
     65      IF( ntile == jpnijtile )  THEN              ! Do only after all tiles finish 
     66         IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     67            ! TODO: TO BE TILED 
     68            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
     69            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     70            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
     71         ENDIF 
    6672      ENDIF 
    6773      ! 
     
    7783      END SELECT 
    7884      ! 
    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 )  
     85      IF( ntile == jpnijtile )  THEN              ! Do only after all tiles finish 
     86         IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
     87            ! TODO: TO BE TILED 
     88            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     89            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     90            ! TODO: TO BE TILED 
     91            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
     92            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
     93            DEALLOCATE( ztrdt, ztrds ) 
     94         ENDIF 
     95 
     96         !                                        !* print mean trends (used for debugging) 
     97         ! TODO: TO BE TILED 
     98         IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
     99            &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     100         ! 
     101         ! TODO: TO BE TILED 
     102         IF( ln_timing )   CALL timing_stop('tra_ldf') 
    85103      ENDIF 
    86       !                                        !* 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,               & 
    88          &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    89       ! 
    90       IF( ln_timing )   CALL timing_stop('tra_ldf') 
    91104      ! 
    92105   END SUBROUTINE tra_ldf 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/TRA/traldf_iso.F90

    r12489 r12765  
    3636   PUBLIC   tra_ldf_iso   ! routine called by step.F90 
    3737 
    38    LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
    39    LOGICAL  ::   l_hst   ! flag to compute heat transport 
    40  
    4138   !! * Substitutions 
    4239#  include "do_loop_substitute.h90" 
     
    104101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs     ! tracer trend 
    105102      ! 
     103      LOGICAL  ::  l_ptr                                 ! flag to compute poleward transport 
     104      LOGICAL  ::  l_hst                                 ! flag to compute heat transport 
    106105      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    107106      INTEGER  ::  ikt 
     
    110109      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    111110      REAL(wp) ::  zcoef0, ze3w_2, zsign                 !   -      - 
    112       REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
    113       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
     111      REAL(wp), DIMENSION(IND_2D)     ::   zdkt, zdk1t, z2d 
     112      REAL(wp), DIMENSION(IND_2D,jpk) ::   zdit, zdjt, zftu, zftv, ztfw 
    114113      !!---------------------------------------------------------------------- 
    115114      ! 
    116115      IF( kpass == 1 .AND. kt == kit000 )  THEN 
    117          IF(lwp) WRITE(numout,*) 
    118          IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    119          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    120          ! 
    121          akz     (:,:,:) = 0._wp       
    122          ah_wslp2(:,:,:) = 0._wp 
     116         IF( ntile == 1 )  THEN                       ! Do only on the first tile 
     117            ! TODO: TO BE TILED 
     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         ENDIF 
     122         ! 
     123         DO_3D_11_11( 1, jpk ) 
     124            akz     (ji,jj,jk) = 0._wp 
     125            ah_wslp2(ji,jj,jk) = 0._wp 
     126         END_3D 
    123127      ENDIF 
    124128      !    
     
    179183           ! 
    180184         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    181             akz(:,:,:) = ah_wslp2(:,:,:)       
     185            DO_3D_11_11( 1, jpk ) 
     186               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
     187            END_3D 
    182188         ENDIF 
    183189      ENDIF 
     
    219225         DO jk = 1, jpkm1                                 ! Horizontal slab 
    220226            ! 
    221             !                             !== Vertical tracer gradient 
    222             zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    223             ! 
    224             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    225             ELSE                 ;   zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 
    226             ENDIF 
     227            DO_2D_11_11 
     228               !                             !== Vertical tracer gradient 
     229               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
     230               ! 
     231               IF( jk == 1 ) THEN   ;   zdkt(ji,jj) = zdk1t(ji,jj)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
     232               ELSE                 ;   zdkt(ji,jj) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     233               ENDIF 
     234            END_2D 
     235            ! 
    227236            DO_2D_10_10 
    228237               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     
    312321         END_3D 
    313322         ! 
    314          IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==! 
    315              ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==! 
    316             ! 
    317             !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    318                ! note sign is reversed to give down-gradient diffusive transports ) 
    319             IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:)  ) 
    320             !                          ! Diffusive heat transports 
    321             IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 
    322             ! 
    323          ENDIF                                                    !== end pass selection  ==! 
     323         IF( ntile == jpnijtile )  THEN                        ! Do only after all tiles finish 
     324            IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     325                ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==! 
     326               ! 
     327               !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
     328                  ! note sign is reversed to give down-gradient diffusive transports ) 
     329               ! TODO: TO BE TILED 
     330               IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:)  ) 
     331               !                          ! Diffusive heat transports 
     332               ! TODO: TO BE TILED 
     333               IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 
     334               ! 
     335            ENDIF                                                    !== end pass selection  ==! 
     336         ENDIF 
    324337         ! 
    325338         !                                                        ! =============== 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/do_loop_substitute.h90

    r12377 r12765  
    5555! 
    5656#endif 
    57 #define __kIs_     2 
    58 #define __kJs_     2 
    59 #define __kIsm1_   1 
    60 #define __kJsm1_   1 
     57#define __kIs_     ntsi 
     58#define __kJs_     ntsj 
     59#define __kIsm1_   ntsim1 
     60#define __kJsm1_   ntsjm1 
    6161 
    62 #define __kIe_     jpim1 
    63 #define __kJe_     jpjm1 
    64 #define __kIep1_   jpi 
    65 #define __kJep1_   jpj 
     62#define __kIe_     ntei 
     63#define __kJe_     ntej 
     64#define __kIep1_   nteip1 
     65#define __kJep1_   ntejp1 
     66 
     67#define IND_2D     __kIsm1_:__kIep1_,__kJsm1_:__kJep1_ 
    6668 
    6769#define DO_2D_00_00   DO jj = __kJs_, __kJe_   ;   DO ji = __kIs_, __kIe_ 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/par_oce.F90

    r12377 r12765  
    6262   INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj 
    6363 
     64   ! Tiling decomposition 
     65   INTEGER, PUBLIC ::   jpnitile                !: number of tiles following i 
     66   INTEGER, PUBLIC ::   jpnjtile                !: number of tiles following j 
     67   INTEGER, PUBLIC ::   jpnijtile               !: number of tiles in total (jpnitile x jpnjtile) 
     68 
     69   ! Tile indices 
     70   INTEGER, PUBLIC ::   ntsi                    !: start of internal part of tile domain 
     71   INTEGER, PUBLIC ::   ntsj                    ! 
     72   INTEGER, PUBLIC ::   ntei                    !: end of internal part of tile domain 
     73   INTEGER, PUBLIC ::   ntej                    ! 
     74   INTEGER, PUBLIC ::   ntsim1                  !: start of tile domain 
     75   INTEGER, PUBLIC ::   ntsjm1                  ! 
     76   INTEGER, PUBLIC ::   nteip1                  !: end of tile domain 
     77   INTEGER, PUBLIC ::   ntejp1                  ! 
     78   INTEGER, PUBLIC ::   ntile                   !: current tile number 
     79 
    6480   !!--------------------------------------------------------------------- 
    6581   !! Active tracer parameters 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/step.F90

    r12650 r12765  
    8181      !!              -8- Outputs and diagnostics 
    8282      !!---------------------------------------------------------------------- 
    83       INTEGER ::   ji, jj, jk   ! dummy loop indice 
     83      INTEGER ::   ji, jj, jk, jtile   ! dummy loop indice 
    8484      INTEGER ::   indic        ! error indicator if < 0 
    8585!!gm kcall can be removed, I guess 
     
    264264      IF( lrst_oce .AND. ln_zdfosm ) & 
    265265           &             CALL osm_rst    ( kstp,      Nnn, 'WRITE'  )  ! write OSMOSIS outputs + ww (so must do here) to restarts 
     266 
     267      ! Loop over tile domains 
     268      DO jtile = 1, jpnijtile 
     269         IF( ln_tile )   CALL dom_tile( jtile ) 
    266270                         CALL tra_ldf    ( kstp, Nbb, Nnn, ts, Nrhs )  ! lateral mixing 
     271      END DO 
     272      IF( ln_tile )      CALL dom_tile( 0 )                            ! Revert to tile over full domain 
    267273 
    268274                         CALL tra_zdf    ( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vertical mixing and after tracer fields 
  • NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/step_oce.F90

    r12377 r12765  
    6262   USE domvvl          ! variable vertical scale factors  (dom_vvl_sf_nxt routine) 
    6363   !                                                       (dom_vvl_sf_swp routine) 
     64   USE domain   , ONLY : dom_tile 
    6465 
    6566   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine) 
Note: See TracChangeset for help on using the changeset viewer.