New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14834 for NEMO/trunk/src/OCE/DOM – NEMO

Ignore:
Timestamp:
2021-05-11T11:24:44+02:00 (3 years ago)
Author:
hadcv
Message:

#2600: Merge in dev_r14273_HPC-02_Daley_Tiling

Location:
NEMO/trunk/src/OCE/DOM
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/DOM/dom_oce.F90

    r14433 r14834  
    7373   INTEGER         ::   nn_ltile_i, nn_ltile_j 
    7474 
    75    ! Domain tiling (all tiles) 
     75   ! Domain tiling 
    7676   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsi_a       !: start of internal part of tile domain 
    7777   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsj_a       ! 
    7878   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntei_a       !: end of internal part of tile domain 
    7979   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntej_a       ! 
     80   LOGICAL, PUBLIC                                  ::   l_istiled    ! whether tiling is currently active or not 
    8081 
    8182   !                             !: domain MPP decomposition parameters 

  • NEMO/trunk/src/OCE/DOM/domain.F90

    r14433 r14834  
    125125      !           !==  Reference coordinate system  ==! 
    126126      ! 
    127       CALL dom_glo                            ! global domain versus local domain 
    128       CALL dom_nam                            ! read namelist ( namrun, namdom ) 
    129       CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 
     127      CALL dom_glo                      ! global domain versus local domain 
     128      CALL dom_nam                      ! read namelist ( namrun, namdom ) 
     129      CALL dom_tile_init                ! Tile domain 
    130130 
    131131      ! 

  • NEMO/trunk/src/OCE/DOM/domqco.F90

    r14820 r14834  
    123123      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    124124#endif 
     125      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1] 
     126      IF( nn_hls == 2 ) CALL lbc_lnk( 'dom_qco_zgr', r3u(:,:,Kbb), 'U', 1._wp, r3v(:,:,Kbb), 'V', 1._wp, & 
     127         &                                           r3u(:,:,Kmm), 'U', 1._wp, r3v(:,:,Kmm), 'V', 1._wp ) 
    125128      ! 
    126129   END SUBROUTINE dom_qco_zgr 
    … …  
    146149      ! 
    147150      ! 
    148       pr3t(:,:) = pssh(:,:) * r1_ht_0(:,:)   !==  ratio at t-point  ==! 
     151      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     152         pr3t(ji,jj) = pssh(ji,jj) * r1_ht_0(ji,jj)   !==  ratio at t-point  ==! 
     153      END_2D 
    149154      ! 
    150155      ! 
    … …  
    154159#if ! defined key_qcoTest_FluxForm 
    155160      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    156          DO_2D( 0, 0, 0, 0 ) 
    157             pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    158                &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
    159             pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
    160                &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
    161          END_2D 
     161      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     162         pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
     163            &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
     164         pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
     165            &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
     166      END_2D 
    162167!!st      ELSE                                         !- Flux Form   (simple averaging) 
    163168#else 
    164          DO_2D( 0, 0, 0, 0 ) 
    165             pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
    166             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
    167          END_2D 
     169      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     170         pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
     171         pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
     172      END_2D 
    168173!!st      ENDIF 
    169174#endif          
    170175      ! 
    171176      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    172          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     177         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
    173178         ! 
    174179         ! 
    … …  
    179184         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    180185 
    181             DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    182                ! round brackets added to fix the order of floating point operations 
    183                ! needed to ensure halo 1 - halo 2 compatibility 
    184                pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   & 
    185                   &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   & 
    186                   &                      )                                      & ! bracket for halo 1 - halo 2 compatibility 
    187                   &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
    188                   &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  & 
    189                   &                       )                                     & ! bracket for halo 1 - halo 2 compatibility 
    190                   &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
    191             END_2D 
     186      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     187         ! round brackets added to fix the order of floating point operations 
     188         ! needed to ensure halo 1 - halo 2 compatibility 
     189         pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   & 
     190            &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   & 
     191            &                      )                                      & ! bracket for halo 1 - halo 2 compatibility 
     192            &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
     193            &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  & 
     194            &                       )                                     & ! bracket for halo 1 - halo 2 compatibility 
     195            &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
     196      END_2D 
    192197!!st         ELSE                                      !- Flux Form   (simple averaging) 
    193198#else 
    194             DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    195                ! round brackets added to fix the order of floating point operations 
    196                ! needed to ensure halo 1 - halo 2 compatibility 
    197                pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) & 
    198                   &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  &  
    199                   &                       )                                  & ! bracket for halo 1 - halo 2 compatibility 
    200                   &                    ) * r1_hf_0(ji,jj) 
    201             END_2D 
     199      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     200         ! round brackets added to fix the order of floating point operations 
     201         ! needed to ensure halo 1 - halo 2 compatibility 
     202         pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) & 
     203            &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  & 
     204            &                       )                                  & ! bracket for halo 1 - halo 2 compatibility 
     205            &                    ) * r1_hf_0(ji,jj) 
     206      END_2D 
    202207!!st         ENDIF 
    203208#endif 
    204209         !                                                 ! lbc on ratio at u-,v-,f-points 
    205          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     210         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    206211         ! 
    207212      ENDIF 

  • NEMO/trunk/src/OCE/DOM/domtile.F90

    r14090 r14834  
    1313   ! 
    1414   USE prtctl         ! Print control (prt_ctl_info routine) 
     15   USE lib_mpp , ONLY : ctl_stop, ctl_warn 
    1516   USE in_out_manager ! I/O manager 
    1617 
    … …  
    1819   PRIVATE 
    1920 
    20    PUBLIC dom_tile   ! called by step.F90 
     21   PUBLIC dom_tile         ! called by step.F90 
     22   PUBLIC dom_tile_start   ! called by various 
     23   PUBLIC dom_tile_stop    ! "      " 
     24   PUBLIC dom_tile_init    ! called by domain.F90 
     25 
     26   LOGICAL, ALLOCATABLE, DIMENSION(:) ::   l_tilefin    ! whether a tile is finished or not 
    2127 
    2228   !!---------------------------------------------------------------------- 
    … …  
    2733CONTAINS 
    2834 
    29    SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 
     35   SUBROUTINE dom_tile_init 
     36      !!---------------------------------------------------------------------- 
     37      !!                     ***  ROUTINE dom_tile_init  *** 
     38      !! 
     39      !! ** Purpose :   Initialise tile domain variables 
     40      !! 
     41      !! ** Action  : - ntsi, ntsj     : start of internal part of domain 
     42      !!              - ntei, ntej     : end of internal part of domain 
     43      !!              - ntile          : current tile number 
     44      !!              - nijtile        : total number of tiles 
     45      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right) 
     46      !!              - nthb, ntht     :              "         "               (bottom, top) 
     47      !!              - l_istiled      : whether tiling is currently active or not 
     48      !!              - l_tilefin      : whether a tile is finished or not 
     49      !!---------------------------------------------------------------------- 
     50      INTEGER ::   jt                                     ! dummy loop argument 
     51      INTEGER ::   iitile, ijtile                         ! Local integers 
     52      !!---------------------------------------------------------------------- 
     53      IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2') 
     54 
     55      ntile = 0                     ! Initialise to full domain 
     56      nijtile = 1 
     57      ntsi = Nis0 
     58      ntsj = Njs0 
     59      ntei = Nie0 
     60      ntej = Nje0 
     61      nthl = 0 
     62      nthr = 0 
     63      nthb = 0 
     64      ntht = 0 
     65      l_istiled = .FALSE. 
     66 
     67      IF( ln_tile ) THEN            ! Calculate tile domain indices 
     68         iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
     69         ijtile = Nj_0 / nn_ltile_j 
     70         IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     71         IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
     72 
     73         nijtile = iitile * ijtile 
     74         ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) ) 
     75 
     76         l_tilefin(:) = .FALSE. 
     77 
     78         ntsi_a(0) = Nis0                 ! Full domain 
     79         ntsj_a(0) = Njs0 
     80         ntei_a(0) = Nie0 
     81         ntej_a(0) = Nje0 
     82 
     83         DO jt = 1, nijtile               ! Tile domains 
     84            ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
     85            ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
     86            ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
     87            ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
     88         ENDDO 
     89      ENDIF 
     90 
     91      IF(lwp) THEN                  ! control print 
     92         WRITE(numout,*) 
     93         WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
     94         WRITE(numout,*) '~~~~~~~~' 
     95         IF( ln_tile ) THEN 
     96            WRITE(numout,*) iitile, 'tiles in i' 
     97            WRITE(numout,*) '    Starting indices' 
     98            WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
     99            WRITE(numout,*) '    Ending indices' 
     100            WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
     101            WRITE(numout,*) ijtile, 'tiles in j' 
     102            WRITE(numout,*) '    Starting indices' 
     103            WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
     104            WRITE(numout,*) '    Ending indices' 
     105            WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
     106         ELSE 
     107            WRITE(numout,*) 'No domain tiling' 
     108            WRITE(numout,*) '    i indices =', ntsi, ':', ntei 
     109            WRITE(numout,*) '    j indices =', ntsj, ':', ntej 
     110         ENDIF 
     111      ENDIF 
     112   END SUBROUTINE dom_tile_init 
     113 
     114 
     115   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr ) 
    30116      !!---------------------------------------------------------------------- 
    31117      !!                     ***  ROUTINE dom_tile  *** 
    32118      !! 
    33       !! ** Purpose :   Set tile domain variables 
     119      !! ** Purpose :   Set the current tile and its domain indices 
    34120      !! 
    35121      !! ** Action  : - ktsi, ktsj     : start of internal part of domain 
    36122      !!              - ktei, ktej     : end of internal part of domain 
    37       !!              - ntile          : current tile number 
    38       !!              - nijtile        : total number of tiles 
     123      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right) 
     124      !!              - nthb, ntht     :              "         "               (bottom, top) 
     125      !!              - ktile          : set the current tile number (ntile) 
    39126      !!---------------------------------------------------------------------- 
    40127      INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices 
    41       INTEGER, INTENT(in), OPTIONAL :: ktile              ! Tile number 
    42       INTEGER ::   jt                                     ! dummy loop argument 
    43       INTEGER ::   iitile, ijtile                         ! Local integers 
    44       CHARACTER (len=11) ::   charout 
    45       !!---------------------------------------------------------------------- 
    46       IF( PRESENT(ktile) .AND. ln_tile ) THEN 
    47          ntile = ktile                 ! Set domain indices for tile 
    48          ktsi = ntsi_a(ktile) 
    49          ktsj = ntsj_a(ktile) 
    50          ktei = ntei_a(ktile) 
    51          ktej = ntej_a(ktile) 
    52  
     128      INTEGER, INTENT(in)  :: ktile                       ! Tile number 
     129      LOGICAL, INTENT(in), OPTIONAL :: ldhold             ! Pause/resume (.true.) or set (.false.) current tile 
     130      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr    ! Debug information (added to warnings) 
     131      CHARACTER(len=23) :: clstr 
     132      LOGICAL :: llhold 
     133      CHARACTER(len=11)   :: charout 
     134      INTEGER :: iitile 
     135      !!---------------------------------------------------------------------- 
     136      llhold = .FALSE. 
     137      IF( PRESENT(ldhold) ) llhold = ldhold 
     138      clstr = '' 
     139      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     140 
     141      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.') 
     142      IF( .NOT. llhold ) THEN 
     143         IF( .NOT. l_istiled ) THEN 
     144            CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr) 
     145            RETURN 
     146         ENDIF 
     147 
     148         IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE.         ! If setting a new tile, the current tile is complete 
     149 
     150         ntile = ktile                                      ! Set the new tile 
    53151         IF(sn_cfctl%l_prtctl) THEN 
    54             WRITE(charout, FMT="('ntile =', I4)") ktile 
     152            WRITE(charout, FMT="('ntile =', I4)") ntile 
    55153            CALL prt_ctl_info( charout ) 
    56154         ENDIF 
    57       ELSE 
    58          ntile = 0                     ! Initialise to full domain 
    59          nijtile = 1 
    60          ktsi = Nis0 
    61          ktsj = Njs0 
    62          ktei = Nie0 
    63          ktej = Nje0 
    64  
    65          IF( ln_tile ) THEN            ! Calculate tile domain indices 
    66             iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
    67             ijtile = Nj_0 / nn_ltile_j 
    68             IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
    69             IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
    70  
    71             nijtile = iitile * ijtile 
    72             ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 
    73  
    74             ntsi_a(0) = ktsi                 ! Full domain 
    75             ntsj_a(0) = ktsj 
    76             ntei_a(0) = ktei 
    77             ntej_a(0) = ktej 
    78  
    79             DO jt = 1, nijtile               ! Tile domains 
    80                ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
    81                ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
    82                ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
    83                ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
    84             ENDDO 
    85          ENDIF 
    86  
    87          IF(lwp) THEN                  ! control print 
    88             WRITE(numout,*) 
    89             WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
    90             WRITE(numout,*) '~~~~~~~~' 
    91             IF( ln_tile ) THEN 
    92                WRITE(numout,*) iitile, 'tiles in i' 
    93                WRITE(numout,*) '    Starting indices' 
    94                WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
    95                WRITE(numout,*) '    Ending indices' 
    96                WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
    97                WRITE(numout,*) ijtile, 'tiles in j' 
    98                WRITE(numout,*) '    Starting indices' 
    99                WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
    100                WRITE(numout,*) '    Ending indices' 
    101                WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
    102             ELSE 
    103                WRITE(numout,*) 'No domain tiling' 
    104                WRITE(numout,*) '    i indices =', ktsi, ':', ktei 
    105                WRITE(numout,*) '    j indices =', ktsj, ':', ktej 
    106             ENDIF 
    107          ENDIF 
    108       ENDIF 
     155      ENDIF 
     156 
     157      ktsi = ntsi_a(ktile)                                  ! Set the domain indices 
     158      ktsj = ntsj_a(ktile) 
     159      ktei = ntei_a(ktile) 
     160      ktej = ntej_a(ktile) 
     161 
     162      ! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile) 
     163      nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0 
     164      iitile = Ni_0 / nn_ltile_i 
     165      IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     166      IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1     ) ) nthl = 1 ; ENDIF    ! Left adjacent tile 
     167      IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1     ) ) nthr = 1 ; ENDIF    ! Right  "  " 
     168      IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF    ! Bottom "  " 
     169      IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF    ! Top    "  " 
    109170   END SUBROUTINE dom_tile 
    110171 
     172 
     173   SUBROUTINE dom_tile_start( ldhold, cstr ) 
     174      !!---------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE dom_tile_start  *** 
     176      !! 
     177      !! ** Purpose : Start or resume the use of tiling 
     178      !! 
     179      !! ** Method  : dom_tile_start & dom_tile_stop are used to declare a tiled region of code. 
     180      !! 
     181      !!              Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region. 
     182      !!              After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must 
     183      !!              be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete 
     184      !!              (ln_tilefin(:) = .false.). 
     185      !! 
     186      !!              Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start 
     187      !!              with ldhold = .true.. This can be used to temporarily revert back to using the full domain. 
     188      !! 
     189      !!                 CALL dom_tile_start                                  ! Enable tiling 
     190      !!                    CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n)    ! Set current tile "n" 
     191      !!                    ... 
     192      !!                    CALL dom_tile_stop(.TRUE.)                        ! Pause tiling (temporarily disable) 
     193      !!                    ... 
     194      !!                    CALL dom_tile_start(.TRUE.)                       ! Resume tiling 
     195      !!                 CALL dom_tile_stop                                   ! Disable tiling 
     196      !!---------------------------------------------------------------------- 
     197      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Resume (.true.) or start (.false.) 
     198      LOGICAL :: llhold 
     199      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     200      CHARACTER(len=23) :: clstr 
     201      !!---------------------------------------------------------------------- 
     202      llhold = .FALSE. 
     203      IF( PRESENT(ldhold) ) llhold = ldhold 
     204      clstr = '' 
     205      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     206 
     207      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.') 
     208      IF( l_istiled ) THEN 
     209         CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr) 
     210         RETURN 
     211      ! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop) 
     212      ELSE IF( llhold .AND. ntile == 0 ) THEN 
     213         CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr) 
     214         RETURN 
     215      ENDIF 
     216 
     217      ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used. 
     218      IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr) 
     219      l_istiled = .TRUE. 
     220   END SUBROUTINE dom_tile_start 
     221 
     222 
     223   SUBROUTINE dom_tile_stop( ldhold, cstr ) 
     224      !!---------------------------------------------------------------------- 
     225      !!                     ***  ROUTINE dom_tile_stop  *** 
     226      !! 
     227      !! ** Purpose : End or pause the use of tiling 
     228      !! 
     229      !! ** Method  : See dom_tile_start 
     230      !!---------------------------------------------------------------------- 
     231      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Pause (.true.) or stop (.false.) 
     232      LOGICAL :: llhold 
     233      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     234      CHARACTER(len=23) :: clstr 
     235      !!---------------------------------------------------------------------- 
     236      llhold = .FALSE. 
     237      IF( PRESENT(ldhold) ) llhold = ldhold 
     238      clstr = '' 
     239      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     240 
     241      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.') 
     242      IF( .NOT. l_istiled ) THEN 
     243         CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr) 
     244         RETURN 
     245      ENDIF 
     246 
     247      ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used. 
     248      ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset 
     249      CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr) 
     250      IF( .NOT. llhold ) l_tilefin(:) = .FALSE. 
     251      l_istiled = .FALSE. 
     252   END SUBROUTINE dom_tile_stop 
    111253   !!====================================================================== 
    112254END MODULE domtile 

  • NEMO/trunk/src/OCE/DOM/domutl.F90

    r14072 r14834  
    2222 
    2323   INTERFACE is_tile 
    24       MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 
     24      MODULE PROCEDURE is_tile_2d_sp, is_tile_3d_sp, is_tile_4d_sp, is_tile_2d_dp, is_tile_3d_dp, is_tile_4d_dp 
    2525   END INTERFACE is_tile 
    2626 
    … …  
    116116 
    117117 
    118    FUNCTION is_tile_2d( pt ) 
    119       !! 
    120       REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt 
    121       INTEGER :: is_tile_2d 
    122       !! 
    123       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    124          is_tile_2d = 1 
     118   INTEGER FUNCTION is_tile_2d_sp( pt ) 
     119      REAL(sp), DIMENSION(:,:), INTENT(in) ::   pt 
     120 
     121      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     122         is_tile_2d_sp = 1 
    125123      ELSE 
    126          is_tile_2d = 0 
     124         is_tile_2d_sp = 0 
    127125      ENDIF 
    128    END FUNCTION is_tile_2d 
     126   END FUNCTION is_tile_2d_sp 
    129127 
    130128 
    131    FUNCTION is_tile_3d( pt ) 
    132       !! 
    133       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt 
    134       INTEGER :: is_tile_3d 
    135       !! 
    136       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    137          is_tile_3d = 1 
     129   INTEGER FUNCTION is_tile_2d_dp( pt ) 
     130      REAL(dp), DIMENSION(:,:), INTENT(in) ::   pt 
     131 
     132      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     133         is_tile_2d_dp = 1 
    138134      ELSE 
    139          is_tile_3d = 0 
     135         is_tile_2d_dp = 0 
    140136      ENDIF 
    141    END FUNCTION is_tile_3d 
     137   END FUNCTION is_tile_2d_dp 
    142138 
    143139 
    144    FUNCTION is_tile_4d( pt ) 
    145       !! 
    146       REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
    147       INTEGER :: is_tile_4d 
    148       !! 
    149       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    150          is_tile_4d = 1 
     140   INTEGER FUNCTION is_tile_3d_sp( pt ) 
     141      REAL(sp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     142 
     143      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     144         is_tile_3d_sp = 1 
    151145      ELSE 
    152          is_tile_4d = 0 
     146         is_tile_3d_sp = 0 
    153147      ENDIF 
    154    END FUNCTION is_tile_4d 
     148   END FUNCTION is_tile_3d_sp 
    155149 
     150 
     151   INTEGER FUNCTION is_tile_3d_dp( pt ) 
     152      REAL(dp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     153 
     154      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     155         is_tile_3d_dp = 1 
     156      ELSE 
     157         is_tile_3d_dp = 0 
     158      ENDIF 
     159   END FUNCTION is_tile_3d_dp 
     160 
     161 
     162   INTEGER FUNCTION is_tile_4d_sp( pt ) 
     163      REAL(sp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     164 
     165      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     166         is_tile_4d_sp = 1 
     167      ELSE 
     168         is_tile_4d_sp = 0 
     169      ENDIF 
     170   END FUNCTION is_tile_4d_sp 
     171 
     172 
     173   INTEGER FUNCTION is_tile_4d_dp( pt ) 
     174      REAL(dp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     175 
     176      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     177         is_tile_4d_dp = 1 
     178      ELSE 
     179         is_tile_4d_dp = 0 
     180      ENDIF 
     181   END FUNCTION is_tile_4d_dp 
    156182   !!====================================================================== 
    157183END MODULE domutl 

  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r14433 r14834  
    204204      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    205205      gdepw(:,:,1,Kbb) = 0.0_wp 
    206       DO_3D( 1, 1, 1, 1, 2, jpk )                     ! vertical sum 
     206      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )                     ! vertical sum 
    207207         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    208208         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    … …  
    404404         zwu(:,:) = 0._wp 
    405405         zwv(:,:) = 0._wp 
    406          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   ! a - first derivative: diffusive fluxes 
     406         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )       ! a - first derivative: diffusive fluxes 
    407407            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    408408               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    … …  
    412412            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    413413         END_3D 
    414          DO_2D( 1, 1, 1, 1 )             ! b - correction for last oceanic u-v points 
     414         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                 ! b - correction for last oceanic u-v points 
    415415            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    416416            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    … …  
    423423         !                               ! d - thickness diffusion transport: boundary conditions 
    424424         !                             (stored for tracer advction and continuity equation) 
    425          CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     425         IF( nn_hls == 1 ) CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    426426         ! 4 - Time stepping of baroclinic scale factors 
    427427         ! --------------------------------------------- 
    … …  
    640640      gdepw(:,:,1,Kmm) = 0.0_wp 
    641641      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    642       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     642      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 
    643643        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    644644                                                           ! 1 for jk = mikt 

  • NEMO/trunk/src/OCE/DOM/dtatsd.F90

    r14189 r14834  
    141141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    142142      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    143       INTEGER ::   itile 
    144143      INTEGER, DIMENSION(jpts), SAVE :: irec_b, irec_n 
    145144      REAL(wp)::   zl, zi                             ! local scalars 
    … …  
    147146      !!---------------------------------------------------------------------- 
    148147      ! 
    149       IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
    150          itile = ntile 
    151          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     148      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     149         IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain 
    152150            CALL fld_read( kt, 1, sf_tsd )   !==   read T & S data at kt time step   ==! 
    153151      ! 
    … …  
    195193         ENDIF 
    196194!!gm end 
    197          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     195         IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain 
    198196      ENDIF 
    199197      ! 
    … …  
    205203      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    206204         ! 
    207          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     205         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    208206            IF( kt == nit000 .AND. lwp )THEN 
    209207               WRITE(numout,*) 

  • NEMO/trunk/src/OCE/DOM/istate.F90

    r14139 r14834  
    152152      ! 
    153153!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    154       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    155155         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    156156         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
Note: See TracChangeset for help on using the changeset viewer.