Changeset 13566


Ignore:
Timestamp:
2020-10-05T16:20:37+02:00 (4 months ago)
Author:
clem
Message:

4.0-HEAD: reduce number of communications for UMx advection scheme (SI3).

File:
1 edited

Legend:

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

    r13284 r13566  
    172172         END DO 
    173173      END DO 
    174       CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
    175       CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 
     174      CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1. ) 
     175      CALL lbc_lnk( 'icedyn_adv_umx', zes_max, 'T', 1. ) 
    176176      ! 
    177177      ! 
     
    392392         ENDIF 
    393393         ! 
     394         ! --- Lateral boundary conditions --- ! 
     395         IF    ( ln_pnd_LEV .AND. ln_pnd_lids ) THEN 
     396            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
     397               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 
     398         ELSEIF( ln_pnd_LEV .AND. .NOT.ln_pnd_lids ) THEN 
     399            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
     400               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 
     401         ELSE 
     402            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp ) 
     403         ENDIF 
     404         CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) 
     405         CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T', 1._wp ) 
     406         ! 
    394407         !== Open water area ==! 
    395408         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
     
    400413            END DO 
    401414         END DO 
    402          CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. ) 
    403          ! 
     415         CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1._wp ) 
    404416         ! 
    405417         ! --- Ensure non-negative fields and in-bound thicknesses --- ! 
     
    461473      !!             work on H (and not V). It is partly related to the multi-category approach 
    462474      !!             Therefore, after advection we limit the thickness to the largest value of the 9-points around (only if ice 
    463       !!             concentration is small). Since we do not limit S and T, large values can occur at the edge but it does not really matter 
    464       !!             since sv_i and e_i are still good. 
     475      !!             concentration is small). We also limit S and T. 
    465476      !!---------------------------------------------------------------------- 
    466477      REAL(wp)                        , INTENT(in   )           ::   pamsk            ! advection of concentration (1) or other tracers (0) 
     
    506517      IF( pamsk == 0._wp ) THEN 
    507518         DO jl = 1, jpl 
    508             DO jj = 1, jpjm1 
     519            DO jj = 2, jpjm1 
    509520               DO ji = 1, fs_jpim1 
    510521                  IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 
     
    516527                  ENDIF 
    517528                  ! 
     529               END DO 
     530            END DO 
     531            DO jj = 1, jpjm1 
     532               DO ji = fs_2, fs_jpim1 
    518533                  IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 
    519534                     zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj) 
     
    553568      IF( PRESENT( pua_ho ) ) THEN 
    554569         DO jl = 1, jpl 
     570            DO jj = 2, jpjm1 
     571               DO ji = 1, fs_jpim1 
     572                  pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) 
     573                  pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) 
     574              END DO 
     575            END DO 
    555576            DO jj = 1, jpjm1 
    556                DO ji = 1, fs_jpim1 
    557                   pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
    558                   pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
     577               DO ji = fs_2, fs_jpim1 
     578                  pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
     579                  pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
    559580              END DO 
    560581            END DO 
     
    573594         END DO 
    574595      END DO 
    575       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. ) 
    576596      ! 
    577597   END SUBROUTINE adv_umx 
     
    614634            ! 
    615635            DO jl = 1, jpl              !-- flux in x-direction 
    616                DO jj = 1, jpjm1 
     636               DO jj = 1, jpj 
    617637                  DO ji = 1, fs_jpim1 
    618638                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
     
    622642            ! 
    623643            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    624                DO jj = 2, jpjm1 
     644               DO jj = 1, jpj 
    625645                  DO ji = fs_2, fs_jpim1 
    626646                     ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
     
    631651               END DO 
    632652            END DO 
    633             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    634653            ! 
    635654            DO jl = 1, jpl              !-- flux in y-direction 
    636655               DO jj = 1, jpjm1 
    637                   DO ji = 1, fs_jpim1 
     656                  DO ji = fs_2, fs_jpim1 
    638657                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    639658                  END DO 
     
    645664            DO jl = 1, jpl              !-- flux in y-direction 
    646665               DO jj = 1, jpjm1 
    647                   DO ji = 1, fs_jpim1 
     666                  DO ji = 1, jpi 
    648667                     pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    649668                  END DO 
     
    653672            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    654673               DO jj = 2, jpjm1 
    655                   DO ji = fs_2, fs_jpim1 
     674                  DO ji = 1, jpi 
    656675                     ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    657676                        &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     
    661680               END DO 
    662681            END DO 
    663             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    664682            ! 
    665683            DO jl = 1, jpl              !-- flux in x-direction 
    666                DO jj = 1, jpjm1 
     684               DO jj = 2, jpjm1 
    667685                  DO ji = 1, fs_jpim1 
    668686                     pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
     
    717735         ! 
    718736         DO jl = 1, jpl 
    719             DO jj = 1, jpjm1 
     737            DO jj = 1, jpj 
    720738               DO ji = 1, fs_jpim1 
    721739                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
     740               END DO 
     741            END DO 
     742            DO jj = 1, jpjm1 
     743               DO ji = 1, jpi 
    722744                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    723745               END DO 
     
    737759            ! 
    738760            DO jl = 1, jpl              !-- flux in x-direction 
    739                DO jj = 1, jpjm1 
     761               DO jj = 1, jpj 
    740762                  DO ji = 1, fs_jpim1 
    741763                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
     
    746768 
    747769            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    748                DO jj = 2, jpjm1 
     770               DO jj = 1, jpj 
    749771                  DO ji = fs_2, fs_jpim1 
    750772                     ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
     
    755777               END DO 
    756778            END DO 
    757             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    758779 
    759780            DO jl = 1, jpl              !-- flux in y-direction 
    760781               DO jj = 1, jpjm1 
    761                   DO ji = 1, fs_jpim1 
     782                  DO ji = fs_2, fs_jpim1 
    762783                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    763784                  END DO 
     
    770791            DO jl = 1, jpl              !-- flux in y-direction 
    771792               DO jj = 1, jpjm1 
    772                   DO ji = 1, fs_jpim1 
     793                  DO ji = 1, jpi 
    773794                     pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    774795                  END DO 
     
    779800            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    780801               DO jj = 2, jpjm1 
    781                   DO ji = fs_2, fs_jpim1 
     802                  DO ji = 1, jpi 
    782803                     ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    783804                        &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     
    787808               END DO 
    788809            END DO 
    789             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    790810            ! 
    791811            DO jl = 1, jpl              !-- flux in x-direction 
    792                DO jj = 1, jpjm1 
     812               DO jj = 2, jpjm1 
    793813                  DO ji = 1, fs_jpim1 
    794814                     pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
     
    953973         !         
    954974         DO jl = 1, jpl 
    955             DO jj = 1, jpjm1 
     975            DO jj = 2, jpjm1 
    956976               DO ji = 1, fs_jpim1   ! vector opt. 
    957977                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     
    964984         ! 
    965985         DO jl = 1, jpl 
    966             DO jj = 1, jpjm1 
     986            DO jj = 2, jpjm1 
    967987               DO ji = 1, fs_jpim1   ! vector opt. 
    968988                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     
    976996         ! 
    977997         DO jl = 1, jpl 
    978             DO jj = 1, jpjm1 
     998            DO jj = 2, jpjm1 
    979999               DO ji = 1, fs_jpim1   ! vector opt. 
    9801000                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     
    9921012         ! 
    9931013         DO jl = 1, jpl 
    994             DO jj = 1, jpjm1 
     1014            DO jj = 2, jpjm1 
    9951015               DO ji = 1, fs_jpim1   ! vector opt. 
    9961016                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     
    10081028         ! 
    10091029         DO jl = 1, jpl 
    1010             DO jj = 1, jpjm1 
     1030            DO jj = 2, jpjm1 
    10111031               DO ji = 1, fs_jpim1   ! vector opt. 
    10121032                  zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     
    10311051      IF( ll_neg ) THEN 
    10321052         DO jl = 1, jpl 
    1033             DO jj = 1, jpjm1 
     1053            DO jj = 2, jpjm1 
    10341054               DO ji = 1, fs_jpim1 
    10351055                  IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
     
    10431063      !                                                     !-- High order flux in i-direction  --! 
    10441064      DO jl = 1, jpl 
    1045          DO jj = 1, jpjm1 
     1065         DO jj = 2, jpjm1 
    10461066            DO ji = 1, fs_jpim1   ! vector opt. 
    10471067               pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 
     
    11121132         DO jl = 1, jpl 
    11131133            DO jj = 1, jpjm1 
    1114                DO ji = 1, fs_jpim1 
     1134               DO ji = fs_2, fs_jpim1 
    11151135                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    11161136                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     
    11221142         DO jl = 1, jpl 
    11231143            DO jj = 1, jpjm1 
    1124                DO ji = 1, fs_jpim1 
     1144               DO ji = fs_2, fs_jpim1 
    11251145                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    11261146                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
     
    11331153         DO jl = 1, jpl 
    11341154            DO jj = 1, jpjm1 
    1135                DO ji = 1, fs_jpim1 
     1155               DO ji = fs_2, fs_jpim1 
    11361156                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    11371157                  zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     
    11481168         DO jl = 1, jpl 
    11491169            DO jj = 1, jpjm1 
    1150                DO ji = 1, fs_jpim1 
     1170               DO ji = fs_2, fs_jpim1 
    11511171                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    11521172                  zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     
    11631183         DO jl = 1, jpl 
    11641184            DO jj = 1, jpjm1 
    1165                DO ji = 1, fs_jpim1 
     1185               DO ji = fs_2, fs_jpim1 
    11661186                  zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    11671187                  zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     
    11861206         DO jl = 1, jpl 
    11871207            DO jj = 1, jpjm1 
    1188                DO ji = 1, fs_jpim1 
     1208               DO ji = fs_2, fs_jpim1 
    11891209                  IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    11901210                     pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
     
    11981218      DO jl = 1, jpl 
    11991219         DO jj = 1, jpjm1 
    1200             DO ji = 1, fs_jpim1   ! vector opt. 
     1220            DO ji = fs_2, fs_jpim1 
    12011221               pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 
    12021222            END DO 
     
    12351255      ! -------------------------------------------------- 
    12361256      DO jl = 1, jpl 
    1237          DO jj = 1, jpjm1 
     1257         DO jj = 2, jpjm1 
    12381258            DO ji = 1, fs_jpim1   ! vector opt. 
    12391259               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
     1260            END DO 
     1261         END DO 
     1262         DO jj = 1, jpjm1 
     1263            DO ji = fs_2, fs_jpim1   ! vector opt. 
    12401264               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
    12411265            END DO 
     
    13521376      ! --------------------------------- 
    13531377      DO jl = 1, jpl 
    1354          DO jj = 1, jpjm1 
     1378         DO jj = 2, jpjm1 
    13551379            DO ji = 1, fs_jpim1   ! vector opt. 
    13561380               zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
     
    13661390 
    13671391         DO jj = 1, jpjm1 
    1368             DO ji = 1, fs_jpim1   ! vector opt. 
     1392            DO ji = fs_2, fs_jpim1   ! vector opt. 
    13691393               zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
    13701394               zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
Note: See TracChangeset for help on using the changeset viewer.