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 12719 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90 – NEMO

Ignore:
Timestamp:
2020-04-08T17:45:31+02:00 (4 years ago)
Author:
francesca
Message:

extra-halo management with positive arrays indices - ticket #2366

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90

    r12601 r12719  
    8383      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8484      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    85       REAL(wp), POINTER, DIMENSION(:,:,:    )           , INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    86       REAL(wp), POINTER, DIMENSION(:,:,:,:,:)           , INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     85      REAL(wp), POINTER, DIMENSION(:,:,:)      , INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     86      REAL(wp), POINTER, DIMENSION(:,:,:,:,:)  , INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8787      ! 
    8888      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    9696      CALL halo_mng_set(jphls) 
    9797 
    98       ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 
    99       ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 
    100       ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 
    101       ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 
     98      ALLOCATE(zwx(jpi,jpj,jpk)) 
     99      ALLOCATE(zwy(jpi,jpj,jpk)) 
     100      ALLOCATE(zslpx(jpi,jpj,jpk)) 
     101      ALLOCATE(zslpy(jpi,jpj,jpk)) 
    102102 
    103103      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
    … …  
    105105      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
    106106      CALL halo_mng_resize(tmask,'T', 1._wp) 
    107       CALL halo_mng_resize(wmask, 'W', 1._wp) 
    108       CALL halo_mng_resize(umask, 'U', 1._wp) 
    109       CALL halo_mng_resize(vmask, 'V', 1._wp) 
     107      CALL halo_mng_resize(wmask,'W', 1._wp) 
     108      CALL halo_mng_resize(umask,'U', 1._wp) 
     109      CALL halo_mng_resize(vmask,'V', 1._wp) 
    110110      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
    111111      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
    112112      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
    113       CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 
    114       CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
    115       CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     113      CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 
     114      CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     115      CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
    116116      CALL halo_mng_resize(pU, 'U', -1._wp) 
    117117      CALL halo_mng_resize(pV, 'V', -1._wp) 
    118118      CALL halo_mng_resize(pW, 'W', 1._wp) 
    119       !       
    120       IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
    121       IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
    122       IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
     119      ! 
     120      IF( ln_isfcav ) CALL halo_mng_resize(mikt,  'T', 1._wp) 
     121      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk,'T', 1._wp) 
     122      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk,'T', 1._wp) 
    123123 
    124124      IF( kt == kit000 )  THEN 
    … …  
    131131         ! Upstream / MUSCL scheme indicator 
    132132         ! 
    133          ALLOCATE( xind(jplbi:jpi,jplbj:jpj,jpk), STAT=ierr ) 
     133         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
    134134         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
    135135         ! 
    136136         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    137             ALLOCATE( upsmsk(jplbi:jpi,jplbj:jpj), STAT=ierr ) 
     137            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    138138            upsmsk(:,:) = 0._wp                             ! not upstream by default 
    139139            ! 
    … …  
    146146         ! 
    147147      ENDIF  
    148  
     148      !       
    149149      l_trd = .FALSE. 
    150150      l_hst = .FALSE. 
    … …  
    162162         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    163163         zwy(:,:,jpk) = 0._wp   
    164          DO_3D_20_20( 1, jpkm1 ) 
     164         DO_3D_10_10( 1, jpkm1 ) 
    165165            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    166166            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    167167         END_3D 
    168          !  
     168         ! lateral boundary conditions   (changed sign) 
     169         !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 
    169170         !                                !-- Slopes of tracer 
    170171         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    171172         zslpy(:,:,jpk) = 0._wp 
    172          DO_3D_31_31( 1, jpkm1 ) 
     173         DO_3D_01_01( 1, jpkm1 ) 
    173174            zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    174175               &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    … …  
    177178         END_3D 
    178179         ! 
    179          DO_3D_31_31( 1, jpkm1 ) 
     180         DO_3D_01_01( 1, jpkm1 ) 
    180181            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    181182               &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    … …  
    186187         END_3D 
    187188         ! 
    188          DO_3D_30_30( 1, jpkm1 ) 
     189         DO_3D_00_00( 1, jpkm1 ) 
    189190            ! MUSCL fluxes 
    190191            z0u = SIGN( 0.5, pU(ji,jj,jk) ) 
    … …  
    202203            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    203204         END_3D 
    204          ! 
    205          DO_3D_30_30( 1, jpkm1 ) 
     205         !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
     206         ! 
     207         DO_3D_00_00( 1, jpkm1 ) 
    206208            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    207209            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    … …  
    228230         !                                !-- Slopes of tracer 
    229231         zslpx(:,:,1) = 0._wp                   ! surface values 
    230          DO_3D_21_21( 2, jpkm1 ) 
     232         DO_3D_11_11( 2, jpkm1 ) 
    231233            zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
    232234               &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
    233235         END_3D 
    234          DO_3D_21_21( 2, jpkm1 ) 
     236         DO_3D_11_11( 2, jpkm1 ) 
    235237            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
    236238               &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   & 
    237239               &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  ) 
    238240         END_3D 
    239          DO_3D_30_30( 1, jpk-2 ) 
     241         DO_3D_00_00( 1, jpk-2 ) 
    240242            z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 
    241243            zalpha = 0.5 + z0w 
    … …  
    247249         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    248250            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    249                DO_2D_21_21 
     251               DO_2D_11_11 
    250252                  zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 
    251253               END_2D 
    … …  
    255257         ENDIF 
    256258         ! 
    257          DO_3D_30_30( 1, jpkm1 ) 
     259         DO_3D_00_00( 1, jpkm1 ) 
    258260            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    259261         END_3D 
    … …  
    262264         ! 
    263265      END DO                     ! end of tracer loop 
    264       ! 
     266 
    265267      DEALLOCATE(zwx,zwy) 
    266268      DEALLOCATE(zslpx,zslpy) 
    267269 
    268270      CALL halo_mng_set(1) 
    269  
     271      ! 
    270272      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
    271273      CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 
    272274      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
    273       CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
    274       CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
     275      CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
     276      CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
    275277      CALL halo_mng_resize(tmask,'T', 1._wp) 
    276       CALL halo_mng_resize(wmask, 'W', 1._wp) 
    277       CALL halo_mng_resize(umask, 'U', 1._wp) 
    278       CALL halo_mng_resize(vmask, 'V', 1._wp) 
     278      CALL halo_mng_resize(wmask,'W', 1._wp) 
     279      CALL halo_mng_resize(umask,'U', 1._wp) 
     280      CALL halo_mng_resize(vmask,'V', 1._wp) 
    279281      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
    280       CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm) 
    281       CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
    282       CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
    283       CALL halo_mng_resize(pU, 'U', 1._wp) 
    284       CALL halo_mng_resize(pV, 'V', 1._wp) 
    285       CALL halo_mng_resize(pW, 'W', 1._wp) 
     282      CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm) 
     283      CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     284      CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     285      CALL halo_mng_resize(pU,'U', 1._wp) 
     286      CALL halo_mng_resize(pV,'V', 1._wp) 
     287      CALL halo_mng_resize(pW,'W', 1._wp) 
    286288 
    287289      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
    288290      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
    289291      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
    290  
    291292   END SUBROUTINE tra_adv_mus 
    292293 
Note: See TracChangeset for help on using the changeset viewer.