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 13554 for NEMO – NEMO

Changeset 13554 for NEMO


Ignore:
Timestamp:
2020-10-02T08:48:30+02:00 (3 years ago)
Author:
clem
Message:

4.0-HEAD: 1st step to drastically reduce the number of communications in Parther advection scheme (SI3). It changes slightly run.stat because some loops are not written in the same order but outputs from a 1year long creg025 simulation are identical

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icedyn_adv_pra.F90

    r13284 r13554  
    362362      !!  
    363363      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     364      INTEGER  ::   jjmin, jjmax                         ! dummy loop indices 
    364365      REAL(wp) ::   zs1max, zslpmax, ztemp               ! local scalars 
    365366      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
     
    369370      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q         !  -      - 
    370371      !----------------------------------------------------------------------- 
     372      ! in order to avoid lbc_lnk (communications): 
     373      !    jj loop must be 1:jpj   if adv_x is called first 
     374      !                and 2:jpj-1 if adv_x is called second 
     375      jjmin = 2     - NINT(pcrh)   ! 1   or 2 
     376      jjmax = jpjm1 + NINT(pcrh)   ! jpj or jpj-1 
    371377      ! 
    372378      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
     
    375381         ! 
    376382         ! Limitation of moments.                                            
    377          DO jj = 2, jpjm1 
     383         DO jj = jjmin, jjmax 
     384             
    378385            DO ji = 1, jpi 
    379386               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
     
    383390               zs1max  = 1.5 * zslpmax 
    384391               zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 
    385                zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    386                   &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  ) 
     392               zs2new  = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 
    387393               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    388394 
     
    393399               psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 
    394400               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    395             END DO 
    396          END DO 
    397  
    398          !  Calculate fluxes and moments between boxes i<-->i+1               
    399          DO jj = 2, jpjm1                      !  Flux from i to i+1 WHEN u GT 0  
    400             DO ji = 1, jpi 
     401 
     402               !  Calculate fluxes and moments between boxes i<-->i+1               
     403               !                                !  Flux from i to i+1 WHEN u GT 0  
    401404               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    402405               zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
     
    413416               zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl) 
    414417 
    415                !  Readjust moments remaining in the box. 
     418               !                                !  Readjust moments remaining in the box. 
    416419               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    417420               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     
    422425               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
    423426            END DO 
    424          END DO 
    425  
    426          DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0. 
     427 
    427428            DO ji = 1, fs_jpim1 
     429               !                                !  Flux from i+1 to i when u LT 0. 
    428430               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
    429431               zalg  (ji,jj) = zalf 
     
    443445               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
    444446            END DO 
    445          END DO 
    446  
    447          DO jj = 2, jpjm1                     !  Readjust moments remaining in the box.  
    448             DO ji = fs_2, fs_jpim1 
     447 
     448            DO ji = fs_2, fs_jpim1  
    449449               zbt  =       zbet(ji-1,jj) 
    450450               zbt1 = 1.0 - zbet(ji-1,jj) 
    451                ! 
     451               !                                !  Readjust moments remaining in the box. 
    452452               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 
    453453               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 
     
    457457               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 
    458458               psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 
    459             END DO 
    460          END DO 
    461  
    462          !   Put the temporary moments into appropriate neighboring boxes.     
    463          DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0. 
    464             DO ji = fs_2, fs_jpim1 
     459 
     460               !   Put the temporary moments into appropriate neighboring boxes.     
     461               !                                !   Flux from i to i+1 IF u GT 0. 
    465462               zbt  =       zbet(ji-1,jj) 
    466463               zbt1 = 1.0 - zbet(ji-1,jj) 
     
    480477               psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 
    481478               psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 
    482             END DO 
    483          END DO 
    484  
    485          DO jj = 2, jpjm1                      !  Flux from i+1 to i IF u LT 0. 
    486             DO ji = fs_2, fs_jpim1 
     479 
     480               !                                !  Flux from i+1 to i IF u LT 0. 
    487481               zbt  =       zbet(ji,jj) 
    488482               zbt1 = 1.0 - zbet(ji,jj) 
     
    502496               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 
    503497            END DO 
     498             
    504499         END DO 
    505500 
     
    507502 
    508503      !-- Lateral boundary conditions 
    509       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    510          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    511          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     504      IF( NINT( pcrh ) == 0 ) THEN   ! adv_x is called after adv_y 
     505         CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
     506            &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     507            &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     508      ENDIF 
    512509      ! 
    513510   END SUBROUTINE adv_x 
     
    531528      !! 
    532529      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     530      INTEGER  ::   jimin, jimax                         ! dummy loop indices 
    533531      REAL(wp) ::   zs1max, zslpmax, ztemp               ! temporary scalars 
    534532      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
     
    538536      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    539537      !--------------------------------------------------------------------- 
     538      ! in order to avoid lbc_lnk (communications): 
     539      !    ji loop must be 1:jpi   if adv_y is called first 
     540      !                and 2:jpi-1 if adv_y is called second 
     541      jimin = 2     - NINT(pcrh)   ! 1   or 2 
     542      jimax = jpim1 + NINT(pcrh)   ! jpi or jpi-1 
    540543      ! 
    541544      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
     
    545548         ! Limitation of moments. 
    546549         DO jj = 1, jpj 
    547             DO ji = fs_2, fs_jpim1 
    548                !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
     550            DO ji = jimin, jimax 
     551               !  Initialize volumes of boxes (=area if adv_y first called, =psm otherwise) 
    549552               psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
    550553               ! 
     
    552555               zs1max  = 1.5 * zslpmax 
    553556               zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 
    554                zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    555                   &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  ) 
     557               zs2new  = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 
    556558               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    557559               ! 
     
    562564               psyy(ji,jj,jl) = zs2new         * rswitch 
    563565               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    564             END DO 
    565          END DO 
    566566  
    567          !  Calculate fluxes and moments between boxes j<-->j+1               
    568          DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    569             DO ji = fs_2, fs_jpim1 
     567               !  Calculate fluxes and moments between boxes j<-->j+1               
     568               !                                !  Flux from j to j+1 WHEN v GT 0    
    570569               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    571570               zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
     
    582581               zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl) 
    583582               ! 
    584                !  Readjust moments remaining in the box. 
     583               !                                !  Readjust moments remaining in the box. 
    585584               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    586585               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     
    593592         END DO 
    594593         ! 
    595          DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    596             DO ji = fs_2, fs_jpim1 
     594         DO jj = 1, jpjm1 
     595            DO ji = jimin, jimax 
     596               !                                !  Flux from j+1 to j when v LT 0. 
    597597               zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
    598598               zalg  (ji,jj) = zalf 
     
    614614         END DO 
    615615 
    616          !  Readjust moments remaining in the box.  
    617616         DO jj = 2, jpjm1 
    618             DO ji = fs_2, fs_jpim1 
     617            DO ji = jimin, jimax 
     618               !                                !  Readjust moments remaining in the box. 
    619619               zbt  =         zbet(ji,jj-1) 
    620620               zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
     
    627627               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 
    628628               psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 
    629             END DO 
    630          END DO 
    631  
    632          !   Put the temporary moments into appropriate neighboring boxes.     
    633          DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
    634             DO ji = fs_2, fs_jpim1 
     629 
     630               !   Put the temporary moments into appropriate neighboring boxes.     
     631               !                                !   Flux from j to j+1 IF v GT 0. 
    635632               zbt  =       zbet(ji,jj-1) 
    636633               zbt1 = 1.0 - zbet(ji,jj-1) 
     
    651648               psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 
    652649               psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 
    653             END DO 
    654          END DO 
    655  
    656          DO jj = 2, jpjm1                      !  Flux from j+1 to j IF v LT 0. 
    657             DO ji = fs_2, fs_jpim1 
     650 
     651               !                                !  Flux from j+1 to j IF v LT 0. 
    658652               zbt  =       zbet(ji,jj) 
    659653               zbt1 = 1.0 - zbet(ji,jj) 
     
    678672 
    679673      !-- Lateral boundary conditions 
    680       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    681          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    682          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     674      IF( NINT( pcrh ) == 0 ) THEN   ! adv_y is called after adv_x 
     675         CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
     676            &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     677            &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     678      ENDIF 
    683679      ! 
    684680   END SUBROUTINE adv_y 
Note: See TracChangeset for help on using the changeset viewer.