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 13922 – NEMO

Changeset 13922


Ignore:
Timestamp:
2020-11-30T15:09:01+01:00 (4 years ago)
Author:
francesca
Message:

bug fixing on loop-fusion branch - ticket #2367

Location:
NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_fct.F90

    r13881 r13922  
    8181      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    8282      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(inout) ::   pU, pV, pW      ! 3 ocean volume flux components 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8484      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8585      ! 
    … …  
    136136      IF( ll_zAimp ) THEN 
    137137         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 
    138          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     138         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    139139            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
    140140            &                               / e3t(ji,jj,jk,Krhs) 
    … …  
    148148         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    149149         !                    !* upstream tracer flux in the i and j direction  
    150          DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     150         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    151151            ! upstream scheme 
    152152            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) 
    … …  
    175175         ENDIF 
    176176         !                
    177          DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* trend and after field with monotonic scheme 
     177         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme 
    178178            !                               ! total intermediate advective trends 
    179179            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    … …  
    191191            ! 
    192192            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 
    193             DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     193            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
    194194               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    195195               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
    … …  
    215215         ! 
    216216         CASE(  2  )                   !- 2nd order centered 
    217             DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     217            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    218218               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 
    219219               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) 
    … …  
    242242               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    243243            END_3D 
     244            IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)! 
    244245            ! 
    245246         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    246247            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
    247248            ztv(:,:,jpk) = 0._wp 
    248             DO_3D( 1, 0, 1, 0, 1, jpkm1 )    ! 1st derivative (gradient) 
     249            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient) 
    249250               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    250251               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    251252            END_3D 
    252253            ! 
    253             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     254            IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    254255            ! 
    255256            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    263264               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    264265            END_3D 
     266            IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    265267            ! 
    266268         END SELECT 
    … …  
    269271         ! 
    270272         CASE(  2  )                   !- 2nd order centered 
    271             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     273            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    272274               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    273275                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
    … …  
    276278         CASE(  4  )                   !- 4th order COMPACT 
    277279            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    278             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     280            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    279281               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    280282            END_3D 
    … …  
    285287         ENDIF 
    286288         !          
    287          CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     289         IF (nn_hls.EQ.1) THEN 
     290            CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
     291         ELSE 
     292            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
     293         END IF 
    288294         ! 
    289295         IF ( ll_zAimp ) THEN 
    290             DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !* trend and after field with monotonic scheme 
     296            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme 
    291297               !                                                ! total intermediate advective trends 
    292298               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    … …  
    298304            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 
    299305            ! 
    300             DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     306            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
    301307               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    302308               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 

  • NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_mus.F90

    r13881 r13922  
    132132         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    133133         zwy(:,:,jpk) = 0._wp   
    134          DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     134         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    135135            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    136136            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    137137         END_3D 
    138138         ! lateral boundary conditions   (changed sign) 
    139          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
     139         IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    140140         !                                !-- Slopes of tracer 
    141141         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    142142         zslpy(:,:,jpk) = 0._wp 
    143          DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
     143         DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) 
    144144            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    145145               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    … …  
    148148         END_3D 
    149149         ! 
    150          DO_3D( 0, 1, 0, 1, 1, jpkm1 )    !-- Slopes limitation 
     150         DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation 
    151151            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    152152               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    … …  
    157157         END_3D 
    158158         ! 
    159          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
     159         DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
    160160            ! MUSCL fluxes 
    161161            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    … …  
    173173            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    174174         END_3D 
    175          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
     175         IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
    176176         ! 
    177177         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend 

  • NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traatf.F90

    r13660 r13922  
    156156         ENDIF 
    157157         ! 
     158         CALL lbc_lnk_multi( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
    158159      ENDIF      
    159160      ! 

  • NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traatf_qco.F90

    r13660 r13922  
    149149         ENDIF 
    150150         ! 
     151         CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1. ) 
    151152      ENDIF 
    152153      ! 
Note: See TracChangeset for help on using the changeset viewer.