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

Changeset 14338


Ignore:
Timestamp:
2021-01-25T08:50:49+01:00 (3 years ago)
Author:
smasson
Message:

dev_r14312_MPI_Interface: simplification of lbclnk and lbcnfd and their generic interfaces, #2598

Location:
NEMO/branches/2021/dev_r14312_MPI_Interface
Files:
1 deleted
90 edited
3 moved

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14312_MPI_Interface/cfgs/SHARED/namelist_ref

    r14255 r14338  
    14981498   jpnj        =   0       !  number of processors following j (set automatically if < 1), see also ln_listonly = T 
    14991499   nn_hls      =   1       !  halo width (applies to both rows and columns) 
     1500   nn_comm     =   1       !  comm choice 
    15001501/ 
    15011502!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ABL/ablmod.F90

    r14239 r14338  
    534534      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    535535      ! 
    536       CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1._wp,  v_abl(:,:,:,nt_a)      , 'T', -1._wp                            ) 
    537       CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T', 1._wp , tq_abl(:,:,:,nt_a,jp_qa), 'T',  1._wp , kfillmode = jpfillnothing )   ! ++++ this should not be needed... 
     536      CALL lbc_lnk( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1._wp,  v_abl(:,:,:,nt_a)      , 'T', -1._wp                            ) 
     537      CALL lbc_lnk( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T', 1._wp , tq_abl(:,:,:,nt_a,jp_qa), 'T',  1._wp , kfillmode = jpfillnothing )   ! ++++ this should not be needed... 
    538538      ! 
    539539#if defined key_xios 
    … …  
    600600      END_2D 
    601601      ! 
    602       CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1.0_wp, zwnd_j(:,:) , 'T', -1.0_wp ) 
     602      CALL lbc_lnk( 'ablmod', zwnd_i(:,:) , 'T', -1.0_wp, zwnd_j(:,:) , 'T', -1.0_wp ) 
    603603      ! 
    604604      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    … …  
    625625      END_2D 
    626626      ! 
    627       CALL lbc_lnk_multi( 'ablmod', ptaui(:,:), 'U', -1.0_wp, ptauj(:,:), 'V', -1.0_wp ) 
     627      CALL lbc_lnk( 'ablmod', ptaui(:,:), 'U', -1.0_wp, ptauj(:,:), 'V', -1.0_wp ) 
    628628 
    629629      CALL iom_put( "taum_oce", ptaum ) 
    … …  
    645645            &                      * ( 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) - pssv_ice(ji,jj) ) 
    646646      END_2D 
    647       CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1.0_wp, ptauj_ice, 'V', -1.0_wp ) 
     647      CALL lbc_lnk( 'ablmod', ptaui_ice, 'U', -1.0_wp, ptauj_ice, 'V', -1.0_wp ) 
    648648      ! 
    649649      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=ptaui_ice  , clinfo1=' abl_stp: putaui : '   & 
    … …  
    664664            &         * ( zztmp2 - pssv_ice(ji,jj) ) 
    665665      END_2D 
    666       CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1.0_wp, ptauj_ice,'V', -1.0_wp ) 
     666      CALL lbc_lnk( 'ablmod', ptaui_ice, 'U', -1.0_wp, ptauj_ice,'V', -1.0_wp ) 
    667667      ! 
    668668      IF(sn_cfctl%l_prtctl) THEN 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icecor.F90

    r13641 r14338  
    116116            ENDIF 
    117117         END_2D 
    118          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
     118         CALL lbc_lnk( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
    119119      ENDIF 
    120120      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_adv_pra.F90

    r14215 r14338  
    115115      CALL icemax3D( ph_ip, zhip_max) 
    116116      CALL icemax3D( zs_i , zsi_max ) 
    117       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
     117      CALL lbc_lnk( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
    118118      ! 
    119119      ! enthalpies 
    … …  
    265265         ! --- Lateral boundary conditions --- ! 
    266266         !     caution: for gradients (sx and sy) the sign changes 
    267          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp  & ! ice volume 
     267         CALL lbc_lnk( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp  & ! ice volume 
    268268            &                                , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
    269269            &                                , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
    270270            &                                , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  ) 
    271          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
     271         CALL lbc_lnk( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
    272272            &                                , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
    273273            &                                , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
    274274            &                                , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  ) 
    275          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
     275         CALL lbc_lnk( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
    276276            &                                , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
    277          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
     277         CALL lbc_lnk( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
    278278            &                                , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  ) 
    279          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
     279         CALL lbc_lnk( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
    280280            &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    281281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    282             CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     282            CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    283283               &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    284284               &                                , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
    285285               &                                , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    286286            IF ( ln_pnd_lids ) THEN 
    287                CALL lbc_lnk_multi( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
     287               CALL lbc_lnk( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
    288288                  &                                , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  ) 
    289289            ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_adv_umx.F90

    r14215 r14338  
    119119      CALL icemax3D( ph_ip, zhip_max) 
    120120      CALL icemax3D( zs_i , zsi_max ) 
    121       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
     121      CALL lbc_lnk( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
    122122      ! 
    123123      ! enthalpies 
    … …  
    360360         ! --- Lateral boundary conditions --- ! 
    361361         IF    ( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. ln_pnd_lids ) THEN 
    362             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 & 
     362            CALL lbc_lnk( '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 & 
    363363               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 
    364364         ELSEIF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. .NOT.ln_pnd_lids ) THEN 
    365             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 & 
     365            CALL lbc_lnk( '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 & 
    366366               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 
    367367         ELSE 
    368             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 ) 
     368            CALL lbc_lnk( '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 ) 
    369369         ENDIF 
    370370         CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) 
    … …  
    11691169            END_2D 
    11701170         END DO 
    1171          CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 
     1171         CALL lbc_lnk( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 
    11721172 
    11731173         DO jl = 1, jpl 
    … …  
    11911191            END_2D 
    11921192         END DO 
    1193          CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp )   ! lateral boundary cond. 
     1193         CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp )   ! lateral boundary cond. 
    11941194 
    11951195      ENDIF 
    … …  
    12481248         END_2D 
    12491249      END DO 
    1250       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     1250      CALL lbc_lnk( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    12511251 
    12521252 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_rhg_eap.F90

    r14120 r14338  
    350350 
    351351      END_2D 
    352       CALL lbc_lnk_multi( 'icedyn_rhg_eap', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
     352      CALL lbc_lnk( 'icedyn_rhg_eap', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    353353      ! 
    354354      !                                  !== Landfast ice parameterization ==! 
    … …  
    488488            zs2(ji,jj) = ( zs2(ji,jj) * zalph1 + zstressmtmp ) * z1_alph1 
    489489         END_2D 
    490          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp) 
     490         CALL lbc_lnk( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp) 
    491491 
    492492        ! Save beta at T-points for further computations 
    … …  
    516516 
    517517         END_2D 
    518          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
     518         CALL lbc_lnk( 'icedyn_rhg_eap', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
    519519 
    520520         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    … …  
    810810 
    811811      END_2D 
    812       CALL lbc_lnk_multi( 'icedyn_rhg_eap', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp, & 
     812      CALL lbc_lnk( 'icedyn_rhg_eap', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp, & 
    813813         &                                    zten_i, 'T', 1.0_wp, zs1    , 'T', 1.0_wp, zs2     , 'T', 1.0_wp, & 
    814814         &                                      zs12, 'F', 1.0_wp ) 
    … …  
    827827         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    828828         ! 
    829          CALL lbc_lnk_multi( 'icedyn_rhg_eap', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, & 
     829         CALL lbc_lnk( 'icedyn_rhg_eap', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, & 
    830830            &                                  ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    831831         ! 
    … …  
    912912      IF( iom_use('yield11') .OR. iom_use('yield12') .OR. iom_use('yield22')) THEN 
    913913 
    914          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
     914         CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
    915915 
    916916         CALL iom_put( 'yield11', zyield11 * aimsk00 ) 
    … …  
    929929         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    930930         ! 
    931          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     931         CALL lbc_lnk( 'icedyn_rhg_eap', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
    932932            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, & 
    933933            &                                    zfU, 'U', -1.0_wp,   zfV, 'V', -1.0_wp ) 
    … …  
    963963         END_2D 
    964964 
    965          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     965         CALL lbc_lnk( 'icedyn_rhg_eap', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
    966966            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
    967967            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_rhg_evp.F90

    r14072 r14338  
    316316 
    317317      END_2D 
    318       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
     318      CALL lbc_lnk( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    319319      ! 
    320320      !                                  !== Landfast ice parameterization ==! 
    … …  
    750750 
    751751      END_2D 
    752       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 
     752      CALL lbc_lnk( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 
    753753         &                                  zs1     , 'T', 1._wp, zs2    , 'T', 1._wp, zs12    , 'F', 1._wp ) 
    754754 
    … …  
    766766         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    767767         ! 
    768          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
     768         CALL lbc_lnk( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
    769769            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    770770         ! 
    … …  
    851851         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    852852         ! 
    853          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     853         CALL lbc_lnk( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
    854854            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 
    855855 
    … …  
    884884         END_2D 
    885885 
    886          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     886         CALL lbc_lnk( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
    887887            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
    888888            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_rhg_vp.F90

    r14072 r14338  
    506506         END DO 
    507507          
    508          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zp_deltastar_t , 'T', 1. , zzt , 'T', 1., zet, 'T', 1. ) 
     508         CALL lbc_lnk( 'icedyn_rhg_vp', zp_deltastar_t , 'T', 1. , zzt , 'T', 1., zet, 'T', 1. ) 
    509509 
    510510         CALL iom_put( 'zzt'        , zzt      )   ! MV DEBUG 
    … …  
    567567         IF( lwp )   WRITE(numout,*) ' outer loop  1d i_out : ', i_out 
    568568          
    569          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCwU ,  'U', -1., zCwV, 'V', -1. ) 
    570          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCorU,  'U', -1., zCorV, 'V', -1. ) 
     569         CALL lbc_lnk( 'icedyn_rhg_vp', zCwU ,  'U', -1., zCwV, 'V', -1. ) 
     570         CALL lbc_lnk( 'icedyn_rhg_vp', zCorU,  'U', -1., zCorV, 'V', -1. ) 
    571571 
    572572         CALL iom_put( 'zCwU'          , zCwU           ) ! MV DEBUG 
    … …  
    674674         END DO 
    675675          
    676          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zrhsu, 'U', -1., zrhsv, 'V',  -1.) 
    677          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zmU_t, 'U', -1., zmV_t, 'V',  -1.) 
    678          CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi_rhsu, 'U', -1., ztauy_oi_rhsv, 'V',  -1.) 
     676         CALL lbc_lnk( 'icedyn_rhg_vp', zrhsu, 'U', -1., zrhsv, 'V',  -1.) 
     677         CALL lbc_lnk( 'icedyn_rhg_vp', zmU_t, 'U', -1., zmV_t, 'V',  -1.) 
     678         CALL lbc_lnk( 'icedyn_rhg_vp', ztaux_oi_rhsu, 'U', -1., ztauy_oi_rhsv, 'V',  -1.) 
    679679 
    680680         CALL iom_put( 'zmU_t'         , zmU_t          ) ! MV DEBUG 
    … …  
    779779         END DO 
    780780 
    781          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zAU  , 'U', 1., zAV  , 'V',  1. ) 
    782          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU  , 'U', 1., zBV  , 'V',  1. ) 
    783          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU  , 'U', 1., zCV  , 'V',  1. ) 
    784          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zDU  , 'U', 1., zDV  , 'V',  1. ) 
    785          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zEU  , 'U', 1., zEV  , 'V',  1. ) 
     781         CALL lbc_lnk( 'icedyn_rhg_vp', zAU  , 'U', 1., zAV  , 'V',  1. ) 
     782         CALL lbc_lnk( 'icedyn_rhg_vp', zBU  , 'U', 1., zBV  , 'V',  1. ) 
     783         CALL lbc_lnk( 'icedyn_rhg_vp', zCU  , 'U', 1., zCV  , 'V',  1. ) 
     784         CALL lbc_lnk( 'icedyn_rhg_vp', zDU  , 'U', 1., zDV  , 'V',  1. ) 
     785         CALL lbc_lnk( 'icedyn_rhg_vp', zEU  , 'U', 1., zEV  , 'V',  1. ) 
    786786                
    787787         CALL iom_put( 'zAU'           , zAU            ) ! MV DEBUG 
    … …  
    885885                     END DO 
    886886 
    887                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime, 'U',  1., zBU_prime, 'U', 1. ) 
     887                     CALL lbc_lnk( 'icedyn_rhg_vp', zFU_prime, 'U',  1., zBU_prime, 'U', 1. ) 
    888888  
    889889                     !----------------------------- 
    … …  
    965965                     END DO 
    966966 
    967                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFV, 'V',  1.) 
     967                     CALL lbc_lnk( 'icedyn_rhg_vp', zFV, 'V',  1.) 
    968968                      
    969969                     !--------------- 
    … …  
    983983                     END DO 
    984984 
    985                      CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFV_prime, 'V',  1., zBV_prime, 'V', 1. ) 
     985                     CALL lbc_lnk( 'icedyn_rhg_vp', zFV_prime, 'V',  1., zBV_prime, 'V', 1. ) 
    986986                      
    987987                     !----------------------------- 
    … …  
    10201020               ENDIF !   ll_v_iterate 
    10211021 
    1022                CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1022               CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    10231023                               
    10241024               !-------------------------------------------------------------------------------------- 
    … …  
    11101110      IF ( lwp ) WRITE(numout,*) ' We are out of outer loop ' 
    11111111 
    1112       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU  , 'U',  1., zFV  , 'V',  1. ) 
    1113       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zBU_prime  , 'U',  1., zBV_prime  , 'V',  1. ) 
    1114       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zFU_prime  , 'U',  1., zFV_prime  , 'V',  1. ) 
    1115       CALL lbc_lnk_multi( 'icedyn_rhg_vp', zCU_prime  , 'U',  1., zCV_prime  , 'V',  1. ) 
     1112      CALL lbc_lnk( 'icedyn_rhg_vp', zFU  , 'U',  1., zFV  , 'V',  1. ) 
     1113      CALL lbc_lnk( 'icedyn_rhg_vp', zBU_prime  , 'U',  1., zBV_prime  , 'V',  1. ) 
     1114      CALL lbc_lnk( 'icedyn_rhg_vp', zFU_prime  , 'U',  1., zFV_prime  , 'V',  1. ) 
     1115      CALL lbc_lnk( 'icedyn_rhg_vp', zCU_prime  , 'U',  1., zCV_prime  , 'V',  1. ) 
    11161116 
    11171117      CALL iom_put( 'zFU'           , zFU            ) ! MV DEBUG 
    … …  
    11251125      CALL iom_put( 'zFV_prime'     , zFV_prime      ) ! MV DEBUG 
    11261126 
    1127       CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1127      CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    11281128 
    11291129      IF ( lwp ) WRITE(numout,*) ' We are about to output uice_dbg ' 
    … …  
    11611161      END DO 
    11621162 
    1163       CALL lbc_lnk_multi( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     1163      CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    11641164 
    11651165      IF ( lwp ) WRITE(numout,*) ' Velocity replaced ' 
    … …  
    12221222      IF ( lwp ) WRITE(numout,*) ' Deformation recalculated ' 
    12231223       
    1224       CALL lbc_lnk_multi( 'icedyn_rhg_vp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
     1224      CALL lbc_lnk( 'icedyn_rhg_vp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
    12251225       
    12261226      !------------------------------------------------------------------------------! 
    … …  
    12491249         END DO 
    12501250 
    1251          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'T', 1. ) 
     1251         CALL lbc_lnk( 'icedyn_rhg_vp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'T', 1. ) 
    12521252       
    12531253      ENDIF 
    … …  
    13071307          
    13081308         ! 
    1309          CALL lbc_lnk_multi( 'icedyn_rhg_vp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1. ) !, & 
     1309         CALL lbc_lnk( 'icedyn_rhg_vp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1. ) !, & 
    13101310!            &                                 ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
    13111311         ! 
    … …  
    13481348         END DO 
    13491349 
    1350          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig_I, 'T', 1., zsig_II, 'T', 1.) 
     1350         CALL lbc_lnk( 'icedyn_rhg_vp', zsig_I, 'T', 1., zsig_II, 'T', 1.) 
    13511351          
    13521352         IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,   zsig_I(:,:)  * zmsk00(:,:) ) ! Normal stress 
    … …  
    13931393         IF ( lwp ) WRITE(numout,*) 'Some shitty stress work done' 
    13941394         ! 
    1395          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zsig1_p, 'T', 1., zsig2_p, 'T', 1.) 
     1395         CALL lbc_lnk( 'icedyn_rhg_vp', zsig1_p, 'T', 1., zsig2_p, 'T', 1.) 
    13961396         !       
    13971397         IF ( lwp ) WRITE(numout,*) ' Beauaaaarflblbllll ' 
    … …  
    14231423         END DO 
    14241424         ! 
    1425          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zspgU, 'U', -1., zspgV, 'V', -1., & 
     1425         CALL lbc_lnk( 'icedyn_rhg_vp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    14261426            &                                 zCorU, 'U', -1., zCorV, 'V', -1. ) 
    14271427         ! 
    … …  
    14531453         END DO 
    14541454             
    1455          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zfU, 'U', -1., zfV, 'V', -1. ) 
     1455         CALL lbc_lnk( 'icedyn_rhg_vp', zfU, 'U', -1., zfV, 'V', -1. ) 
    14561456          
    14571457         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
    … …  
    14851485         END DO 
    14861486 
    1487          CALL lbc_lnk_multi( 'icedyn_rhg_vp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
     1487         CALL lbc_lnk( 'icedyn_rhg_vp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    14881488            &                                 zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    14891489            &                                 zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icesbc.F90

    r14072 r14338  
    8787            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8888         END_2D 
    89          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
     89         CALL lbc_lnk( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
    9090      ENDIF 
    9191      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icethd.F90

    r14072 r14338  
    136136         END_2D 
    137137      ENDIF 
    138       CALL lbc_lnk_multi( 'icethd', zfric, 'T',  1.0_wp, zvel, 'T', 1.0_wp ) 
     138      CALL lbc_lnk( 'icethd', zfric, 'T',  1.0_wp, zvel, 'T', 1.0_wp ) 
    139139      ! 
    140140      !--------------------------------------------------------------------! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icethd_do.F90

    r13601 r14338  
    193193         END_2D 
    194194         !  
    195          CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
     195         CALL lbc_lnk( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
    196196 
    197197      ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/iceupdate.F90

    r14072 r14338  
    345345            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    346346         END_2D 
    347          CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp ) 
     347         CALL lbc_lnk( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp ) 
    348348         ! 
    349349         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
    … …  
    374374         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 
    375375      END_2D 
    376       CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
     376      CALL lbc_lnk( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
    377377      ! 
    378378      IF( ln_timing )   CALL timing_stop('ice_update') 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_oce_interp.F90

    r14227 r14338  
    109109      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
    110110 
    111       CALL lbc_lnk_multi( 'agrif_istate_oce', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
     111      CALL lbc_lnk( 'agrif_istate_oce', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
    112112      CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
    113113 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_oce_sponge.F90

    r14227 r14338  
    236236      END_2D 
    237237       
    238       CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
     238      CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
    239239      ! 
    240240      ! Remove vertical interpolation where not needed: 
    … …  
    368368         fspf_2d(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    369369         END_2D 
    370       CALL lbc_lnk_multi( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp ) 
     370      CALL lbc_lnk( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp ) 
    371371      ! 
    372372#endif 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_user.F90

    r14336 r14338  
    209209      ENDIF 
    210210      ! 
    211       CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 
     211      CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 
    212212      DO_2D( 0, 0, 0, 0 ) 
    213213         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 
    … …  
    251251         ENDIF 
    252252 
    253          CALL lbc_lnk_multi( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 
     253         CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 
    254254      ENDIF 
    255255 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdydyn2d.F90

    r13226 r14338  
    1818   USE bdylib          ! BDY library routines 
    1919   USE phycst          ! physical constants 
     20   USE lib_mpp, ONLY: jpfillnothing 
    2021   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2122   USE wet_dry         ! Use wet dry to get reference ssh level 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdydyn3d.F90

    r13226 r14338  
    1515   USE bdy_oce         ! ocean open boundary conditions 
    1616   USE bdylib          ! for orlanski library routines 
     17   USE lib_mpp, ONLY: jpfillnothing 
    1718   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1819   USE in_out_manager  ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyice.F90

    r13601 r14338  
    9292         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    9393            ! exchange 3d arrays 
    94             CALL lbc_lnk_multi('bdyice', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, oa_i, 'T', 1._wp                   & 
     94            CALL lbc_lnk('bdyice', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, oa_i, 'T', 1._wp                   & 
    9595               &                       , s_i , 'T', 1._wp, t_su, 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp & 
    9696               &                       , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp                                     & 
    9797               &                       , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    9898            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
    99             CALL lbc_lnk_multi('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    100             CALL lbc_lnk_multi('bdyice', t_i , 'T', 1._wp, e_i , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     99            CALL lbc_lnk('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     100            CALL lbc_lnk('bdyice', t_i , 'T', 1._wp, e_i , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    101101         END IF 
    102102      END DO   ! ir 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyini.F90

    r14336 r14338  
    652652         END DO 
    653653      END DO 
    654       CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp )   ! Lateral boundary cond.  
     654      CALL lbc_lnk( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp )   ! Lateral boundary cond.  
    655655 
    656656      ! bdy masks are now set to zero on rim 0 points: 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdytra.F90

    r14072 r14338  
    1818   ! 
    1919   USE in_out_manager ! I/O manager 
     20   USE lib_mpp, ONLY: jpfillnothing 
    2021   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2122   USE lib_mpp, ONLY: ctl_stop 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/CRS/crslbclnk.F90

    r11536 r14338  
    5050      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    5151      ! 
    52       CALL lbc_lnk( 'crslbclnk', pt3d1, cd_type1, psgn, kfillmode, pfillval ) 
     52      CALL lbc_lnk( 'crslbclnk', pt3d1, cd_type1, psgn, kfillmode = kfillmode, pfillval = pfillval ) 
    5353      ! 
    5454      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    … …  
    8080      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    8181      ! 
    82       CALL lbc_lnk( 'crslbclnk', pt2d, cd_type, psgn, kfillmode, pfillval ) 
     82      CALL lbc_lnk( 'crslbclnk', pt2d, cd_type, psgn, kfillmode = kfillmode, pfillval = pfillval ) 
    8383      ! 
    8484      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/dommsk.F90

    r14215 r14338  
    162162            &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
    163163      END_3D 
    164       CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions 
     164      CALL lbc_lnk( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions 
    165165  
    166166      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domqco.F90

    r14179 r14338  
    170170      ! 
    171171      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    172          CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     172         CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
    173173         ! 
    174174         ! 
    … …  
    194194#endif 
    195195         !                                                 ! lbc on ratio at u-,v-,f-points 
    196          CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     196         CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    197197         ! 
    198198      ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domvvl.F90

    r14326 r14338  
    423423         !                               ! d - thickness diffusion transport: boundary conditions 
    424424         !                             (stored for tracer advction and continuity equation) 
    425          CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     425         CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    426426         ! 4 - Time stepping of baroclinic scale factors 
    427427         ! --------------------------------------------- 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynadv_ubs.F90

    r13497 r14338  
    124124         END_2D 
    125125      END DO 
    126       CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
     126      CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
    127127                      &   zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &  
    128128                      &   zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  & 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynatf.F90

    r14224 r14338  
    169169# endif 
    170170      ! 
    171       CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
     171      CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
    172172      ! 
    173173      !                                !* BDY open boundaries 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynhpg.F90

    r14227 r14338  
    462462          END IF 
    463463        END_2D 
    464         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     464        CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    465465      END IF 
    466466      ! 
    … …  
    689689          END IF 
    690690        END_2D 
    691         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     691        CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    692692      END IF 
    693693 
    … …  
    793793      END_3D 
    794794 
    795       CALL lbc_lnk_multi( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
     795      CALL lbc_lnk( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
    796796 
    797797      !------------------------------------------------------------------------- 
    … …  
    10431043            ENDIF 
    10441044         END_2D 
    1045          CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     1045         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    10461046      ENDIF 
    10471047 
    … …  
    11131113      END_2D 
    11141114 
    1115       CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
     1115      CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
    11161116 
    11171117      DO_2D( 0, 0, 0, 0 ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynldf_iso.F90

    r14215 r14338  
    135135         END_3D 
    136136         ! Lateral boundary conditions on the slopes 
    137          CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
     137         CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    138138         ! 
    139139       ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynldf_lap_blp.F90

    r14053 r14338  
    185185      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    186186      ! 
    187       CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
     187      CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    188188      ! 
    189189      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynspg_ts.F90

    r14225 r14338  
    524524         END_2D 
    525525         ! 
    526          CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     526         CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
    527527         ! 
    528528         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
    … …  
    677677         ! 
    678678         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) 
    679             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  & 
     679            CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  & 
    680680                 &                         , hu_e , 'U',  1._wp, hv_e , 'V',  1._wp  & 
    681681                 &                         , hur_e, 'U',  1._wp, hvr_e, 'V',  1._wp  ) 
    682682         ELSE 
    683             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  ) 
     683            CALL lbc_lnk( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  ) 
    684684         ENDIF 
    685685         !                                                 ! open boundaries 
    … …  
    775775         END_2D 
    776776#endif    
    777          CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
     777         CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    778778         ! 
    779779         DO jk=1,jpkm1 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynvor.F90

    r14233 r14338  
    940940               dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji  ,jj-1) ) * 0.5_wp 
    941941            END_2D 
    942             CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp )   ! Lateral boundary conditions 
     942            CALL lbc_lnk( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp )   ! Lateral boundary conditions 
    943943            ! 
    944944         CASE DEFAULT                        !* F-point metric term :   pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) 
    … …  
    948948               dj_e1u_2e1e2f(ji,jj) = ( e1u(ji  ,jj+1) - e1u(ji,jj) )  * 0.5 * r1_e1e2f(ji,jj) 
    949949            END_2D 
    950             CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp )   ! Lateral boundary conditions 
     950            CALL lbc_lnk( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp )   ! Lateral boundary conditions 
    951951         END SELECT 
    952952         ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/wet_dry.F90

    r13558 r14338  
    241241            ENDIF 
    242242         END_2D 
    243          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
     243         CALL lbc_lnk( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
    244244         ! 
    245245         CALL mpp_max('wet_dry', jflag)   !max over the global domain 
    … …  
    257257      ! 
    258258!!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 
    259       CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1.0_wp, pvv(:,:,:,Kmm)  , 'V', -1.0_wp ) 
    260       CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp ) 
     259      CALL lbc_lnk( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1.0_wp, pvv(:,:,:,Kmm)  , 'V', -1.0_wp ) 
     260      CALL lbc_lnk( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp ) 
    261261!!gm 
    262262      ! 
    … …  
    366366         END_2D 
    367367         ! 
    368          CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
     368         CALL lbc_lnk( 'wet_dry', zwdlmtu, 'U', 1.0_wp, zwdlmtv, 'V', 1.0_wp ) 
    369369         ! 
    370370         CALL mpp_max('wet_dry', jflag)   !max over the global domain 
    … …  
    378378      ! 
    379379!!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop 
    380       CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp ) 
     380      CALL lbc_lnk( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp ) 
    381381!!gm end 
    382382      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfcav.F90

    r14072 r14338  
    136136      ! 
    137137      ! lbclnk on melt 
    138       CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
     138      CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
    139139      ! 
    140140      ! output fluxes 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfcpl.F90

    r14143 r14338  
    205205         zssmask0(:,:) = zssmask_b(:,:) 
    206206         ! 
    207          CALL lbc_lnk_multi( 'iscplrst', zssh, 'T', 1.0_wp, zssmask0, 'T', 1.0_wp ) 
     207         CALL lbc_lnk( 'iscplrst', zssh, 'T', 1.0_wp, zssmask0, 'T', 1.0_wp ) 
    208208         ! 
    209209      END DO 
    … …  
    363363         ztmask0(:,:,:) = ztmask1(:,:,:) 
    364364         ! 
    365          CALL lbc_lnk_multi( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1.0_wp, zts0(:,:,:,jp_sal), 'T', 1.0_wp, ztmask0, 'T', 1.0_wp) 
     365         CALL lbc_lnk( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1.0_wp, zts0(:,:,:,jp_sal), 'T', 1.0_wp, ztmask0, 'T', 1.0_wp) 
    366366         ! 
    367367      END DO  ! nn_drown 
    … …  
    691691      ! 
    692692      ! add lbclnk 
    693       CALL lbc_lnk_multi( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 
     693      CALL lbc_lnk( 'iscplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 
    694694         &                            risfcpl_cons_vol(:,:,:)       , 'T', 1.0_wp) 
    695695      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfpar.F90

    r13226 r14338  
    8282      ! 
    8383      ! lbclnk on melt and heat fluxes 
    84       CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
     84      CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 
    8585      ! 
    8686      ! output fluxes 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90

    r14337 r14338  
    1 #if defined SINGLE_PRECISION 
    2 #   if defined DIM_2d 
    3 #      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j) 
    4 #      define PTR_TYPE              TYPE(PTR_2D_sp) 
    5 #      define PTR_ptab              pt2d 
    6 #   endif 
    7 #   if defined DIM_3d 
    8 #      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k) 
    9 #      define PTR_TYPE              TYPE(PTR_3D_sp) 
    10 #      define PTR_ptab              pt3d 
    11 #   endif 
    12 #   if defined DIM_4d 
    13 #      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k,l) 
    14 #      define PTR_TYPE              TYPE(PTR_4D_sp) 
    15 #      define PTR_ptab              pt4d 
    16 #   endif 
    17 #   define PRECISION sp 
    18 #else 
    19 #   if defined DIM_2d 
    20 #      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j) 
    21 #      define PTR_TYPE              TYPE(PTR_2D_dp) 
    22 #      define PTR_ptab              pt2d 
    23 #   endif 
    24 #   if defined DIM_3d 
    25 #      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k) 
    26 #      define PTR_TYPE              TYPE(PTR_3D_dp) 
    27 #      define PTR_ptab              pt3d 
    28 #   endif 
    29 #   if defined DIM_4d 
    30 #      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k,l) 
    31 #      define PTR_TYPE              TYPE(PTR_4D_dp) 
    32 #      define PTR_ptab              pt4d 
    33 #   endif 
    34 #   define PRECISION dp 
     1#if defined DIM_2d 
     2#   define XD      2d 
     3#   define DIMS1   :,: 
     4#   define DIMS2   :,:,1,1 
     5#endif 
     6#if defined DIM_3d 
     7#   define XD      3d 
     8#   define DIMS1   :,:,: 
     9#   define DIMS2   :,:,:,1 
     10#endif 
     11#if defined DIM_4d 
     12#   define XD      4d 
     13#   define DIMS1   :,:,:,: 
     14#   define DIMS2   :,:,:,: 
    3515#endif 
    3616 
    37    SUBROUTINE ROUTINE_MULTI( cdname                                                                               & 
    38       &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   & 
    39       &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   & 
    40       &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  & 
    41       &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  & 
    42       &                    , kfillmode, pfillval, lsend, lrecv, ncsten ) 
     17   SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION(                                                              & 
     18      &                     cdname                                                                                  & 
     19      &                   , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   & 
     20      &                   , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   & 
     21      &                   , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  & 
     22      &                   , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  & 
     23      &                   , kfillmode, pfillval, lsend, lrecv, ncsten ) 
    4324      !!--------------------------------------------------------------------- 
    4425      CHARACTER(len=*)     ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    45       ARRAY_TYPE(:,:,:,:)            , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
    46       ARRAY_TYPE(:,:,:,:)  , OPTIONAL, TARGET, INTENT(inout) ::   pt2   , pt3   , pt4   , pt5   , pt6   , pt7   , pt8   , pt9  , & 
    47          &                                                        pt10  , pt11  , pt12  , pt13  , pt14  , pt15  , pt16 
     26      REAL(PRECISION), DIMENSION(DIMS1)          , TARGET, INTENT(inout) ::   pt1        ! arrays on which the lbc is applied 
     27      REAL(PRECISION), DIMENSION(DIMS1), OPTIONAL, TARGET, INTENT(inout) ::   pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9, & 
     28         &                                                                    pt10, pt11, pt12, pt13, pt14, pt15, pt16 
    4829      CHARACTER(len=1)                       , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points 
    4930      CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 
    … …  
    5839      !! 
    5940      INTEGER                          ::   kfld        ! number of elements that will be attributed 
    60       PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array 
     41      TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(16) ::   ptab_ptr    ! pointer array 
    6142      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    6243      REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
    … …  
    6647      ! 
    6748      !                 ! Load the first array 
    68       CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     49      CALL load_ptr_/**/XD/**/_/**/PRECISION( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    6950      ! 
    7051      !                 ! Look if more arrays are added 
    71       IF( PRESENT(psgn2 ) )   CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    72       IF( PRESENT(psgn3 ) )   CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    73       IF( PRESENT(psgn4 ) )   CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    74       IF( PRESENT(psgn5 ) )   CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    75       IF( PRESENT(psgn6 ) )   CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    76       IF( PRESENT(psgn7 ) )   CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    77       IF( PRESENT(psgn8 ) )   CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    78       IF( PRESENT(psgn9 ) )   CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    79       IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    80       IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    81       IF( PRESENT(psgn12) )   CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    82       IF( PRESENT(psgn13) )   CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    83       IF( PRESENT(psgn14) )   CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    84       IF( PRESENT(psgn15) )   CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    85       IF( PRESENT(psgn16) )   CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     52      IF( PRESENT(psgn2 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     53      IF( PRESENT(psgn3 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     54      IF( PRESENT(psgn4 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     55      IF( PRESENT(psgn5 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     56      IF( PRESENT(psgn6 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     57      IF( PRESENT(psgn7 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     58      IF( PRESENT(psgn8 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     59      IF( PRESENT(psgn9 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     60      IF( PRESENT(psgn10) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     61      IF( PRESENT(psgn11) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     62      IF( PRESENT(psgn12) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     63      IF( PRESENT(psgn13) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     64      IF( PRESENT(psgn14) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     65      IF( PRESENT(psgn15) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     66      IF( PRESENT(psgn16) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    8667      ! 
    87       CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
     68      IF( nn_comm == 1 ) THEN  
     69         CALL lbc_lnk_pt2pt(   cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
     70      ELSE 
     71         CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
     72      ENDIF 
    8873      ! 
    89    END SUBROUTINE ROUTINE_MULTI 
     74   END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION 
    9075 
    9176 
    92    SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     77   SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    9378      !!--------------------------------------------------------------------- 
    94       ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied 
     79      REAL(PRECISION), DIMENSION(DIMS1), TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied 
    9580      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points 
    9681      REAL(PRECISION)               , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary 
    97       PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers 
     82      TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers 
    9883      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points 
    9984      REAL(PRECISION) , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary 
    … …  
    10287      ! 
    10388      kfld                    =  kfld + 1 
    104       ptab_ptr(kfld)%PTR_ptab => ptab 
     89      ptab_ptr(kfld)%pt/**/XD => ptab 
    10590      cdna_ptr(kfld)          =  cdna 
    10691      psgn_ptr(kfld)          =  psgn 
    10792      ! 
    108    END SUBROUTINE ROUTINE_LOAD 
     93   END SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION 
    10994 
    110 #undef PRECISION 
    111 #undef ARRAY_TYPE 
    112 #undef PTR_TYPE 
    113 #undef PTR_ptab 
     95#undef XD 
     96#undef DIMS1 
     97#undef DIMS2 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

    r14337 r14338  
    1 #   define NAT_IN(k)                cd_nat(k)    
    2 #   define SGN_IN(k)                psgn(k) 
    3 #   define F_SIZE(ptab)             kfld 
    4 #   define OPT_K(k)                 ,ipf 
    5 #   if defined DIM_2d 
    6 #      if defined SINGLE_PRECISION 
    7 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)                , INTENT(inout) ::   ptab(f) 
    8 #      else 
    9 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)                , INTENT(inout) ::   ptab(f) 
    10 #      endif 
    11 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    12 #      define K_SIZE(ptab)             1 
    13 #      define L_SIZE(ptab)             1 
    14 #   endif 
    15 #   if defined DIM_3d 
    16 #      if defined SINGLE_PRECISION 
    17 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)                , INTENT(inout) ::   ptab(f) 
    18 #      else 
    19 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)                , INTENT(inout) ::   ptab(f) 
    20 #      endif 
    21 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    22 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    23 #      define L_SIZE(ptab)             1 
    24 #   endif 
    25 #   if defined DIM_4d 
    26 #      if defined SINGLE_PRECISION 
    27 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)                , INTENT(inout) ::   ptab(f) 
    28 #      else 
    29 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)                , INTENT(inout) ::   ptab(f) 
    30 #      endif 
    31 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    32 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    33 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    34 #   endif 
    35 #   if defined SINGLE_PRECISION 
    36 #      define PRECISION sp 
    37 #      define MPI_TYPE MPI_REAL 
    38 #   else 
    39 #      define PRECISION dp 
    40 #      define MPI_TYPE MPI_DOUBLE_PRECISION 
    41 #   endif 
    42  
    43    SUBROUTINE ROUTINE_NC( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    44       INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    45       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     1#if defined DIM_2d 
     2#   define XD                       2d 
     3#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
     4#   define K_SIZE(ptab)             1 
     5#   define L_SIZE(ptab)             1 
     6#endif 
     7#if defined DIM_3d 
     8#   define XD                       3d 
     9#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
     10#   define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
     11#   define L_SIZE(ptab)             1 
     12#endif 
     13#if defined DIM_4d 
     14#   define XD                       4d 
     15#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
     16#   define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
     17#   define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
     18#endif 
     19#define    F_SIZE(ptab)             kfld 
     20 
     21   SUBROUTINE lbc_lnk_neicoll_/**/XD/**/_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    4622      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    47       CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    48       REAL(PRECISION)               , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     23      TYPE(PTR_/**/XD/**/_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c. 
     24      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     25      REAL(PRECISION),  DIMENSION(:), INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     26      INTEGER                       , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    4927      INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
    5028      REAL(PRECISION),      OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    … …  
    261239      ! 
    262240      IF( ll_IdoNFold ) THEN 
    263          IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                     OPT_K(:) )   ! self NFold 
    264          ELSE                    ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:) )   ! mpi  NFold 
     241         IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, cd_nat, psgn                    , ipf )   ! self NFold 
     242         ELSE                    ;   CALL mpp_nfd( ptab, cd_nat, psgn, ifill(jpno), zland, ipf )   ! mpi  NFold 
    265243         ENDIF 
    266244      ENDIF 
    267  
    268    END SUBROUTINE ROUTINE_NC 
    269  
    270 #undef PRECISION 
    271 #undef ARRAY_TYPE 
    272 #undef NAT_IN 
    273 #undef SGN_IN 
     245      ! 
     246   END SUBROUTINE lbc_lnk_neicoll_/**/XD/**/_/**/PRECISION 
     247 
     248#undef XD 
    274249#undef ARRAY_IN 
    275250#undef K_SIZE 
    276251#undef L_SIZE 
    277252#undef F_SIZE 
    278 #undef OPT_K 
    279 #undef MPI_TYPE 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90

    r14337 r14338  
    1 #if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k) 
    3 #   define SGN_IN(k)                psgn(k) 
    4 #   define F_SIZE(ptab)             kfld 
    5 #   define OPT_K(k)                 ,ipf 
    6 #   if defined DIM_2d 
    7 #      if defined SINGLE_PRECISION 
    8 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)                , INTENT(inout) ::   ptab(f) 
    9 #      else 
    10 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)                , INTENT(inout) ::   ptab(f) 
    11 #      endif 
    12 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    13 #      define K_SIZE(ptab)             1 
    14 #      define L_SIZE(ptab)             1 
    15 #   endif 
    16 #   if defined DIM_3d 
    17 #      if defined SINGLE_PRECISION 
    18 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)                , INTENT(inout) ::   ptab(f) 
    19 #      else 
    20 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)                , INTENT(inout) ::   ptab(f) 
    21 #      endif 
    22 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    23 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    24 #      define L_SIZE(ptab)             1 
    25 #   endif 
    26 #   if defined DIM_4d 
    27 #      if defined SINGLE_PRECISION 
    28 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)                , INTENT(inout) ::   ptab(f) 
    29 #      else 
    30 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)                , INTENT(inout) ::   ptab(f) 
    31 #      endif 
    32 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    33 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    34 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    35 #   endif 
    36 #else 
    37 #   if defined SINGLE_PRECISION 
    38 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
    39 #   else 
    40 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
    41 #   endif 
    42 #   define NAT_IN(k)                cd_nat 
    43 #   define SGN_IN(k)                psgn 
    44 #   define F_SIZE(ptab)             1 
    45 #   define OPT_K(k) 
    46 #   if defined DIM_2d 
    47 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    48 #      define K_SIZE(ptab)          1 
    49 #      define L_SIZE(ptab)          1 
    50 #   endif 
    51 #   if defined DIM_3d 
    52 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k) 
    53 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    54 #      define L_SIZE(ptab)          1 
    55 #   endif 
    56 #   if defined DIM_4d 
    57 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l) 
    58 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    59 #      define L_SIZE(ptab)          SIZE(ptab,4) 
    60 #   endif 
    61 #endif 
     1#if defined DIM_2d 
     2#   define XD                       2d 
     3#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
     4#   define K_SIZE(ptab)             1 
     5#   define L_SIZE(ptab)             1 
     6#endif 
     7#if defined DIM_3d 
     8#   define XD                       3d 
     9#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
     10#   define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
     11#   define L_SIZE(ptab)             1 
     12#endif 
     13#if defined DIM_4d 
     14#   define XD                       4d 
     15#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
     16#   define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
     17#   define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
     18#endif 
     19#define    F_SIZE(ptab)             kfld 
    6220 
    63 # if defined SINGLE_PRECISION 
    64 #    define PRECISION sp 
    65 #    define SENDROUTINE mppsend_sp 
    66 #    define RECVROUTINE mpprecv_sp 
    67 # else 
    68 #    define PRECISION dp 
    69 #    define SENDROUTINE mppsend_dp 
    70 #    define RECVROUTINE mpprecv_dp 
    71 # endif 
    72  
    73 #if defined MULTI 
    74    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    75       INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    76 #else 
    77    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv, ncsten ) 
    78 #endif 
    79       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     21   SUBROUTINE lbc_lnk_pt2pt_/**/XD/**/_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
    8022      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    81       CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    82       REAL(PRECISION)               , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     23      TYPE(PTR_/**/XD/**/_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c. 
     24      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     25      REAL(PRECISION),  DIMENSION(:), INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     26      INTEGER                       , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    8327      INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
    8428      REAL(PRECISION),      OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    8529      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    86       LOGICAL,              OPTIONAL, INTENT(in   ) ::   ncsten      ! 5-point or 9-point stencil 
    8730      ! 
    8831      INTEGER  ::   ji, jj, jk, jl, jf, jn      ! dummy loop indices 
    … …  
    9134      INTEGER  ::   ip0j, ip1j, im0j, im1j 
    9235      INTEGER  ::   ishti, ishtj, ishti2, ishtj2 
    93       INTEGER  ::   ierr 
     36      INTEGER  ::   icomm, ierr 
    9437      INTEGER  ::   idxs, idxr 
    9538      INTEGER, DIMENSION(4)  ::   isizei, ishtsi, ishtri, ishtpi 
    … …  
    11053#endif 
    11154      ! 
    112 #if defined key_mpi3 
    113 #   if defined MULTI 
    114       CALL lbc_lnk_nc    ( cdname,  ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    115 #   else 
    116       CALL lbc_lnk_nc_multi(cdname, ptab, cd_nat, psgn, kfillmode=kfillmode, pfillval=pfillval, lsend=lsend, lrecv=lrecv, ncsten=ncsten) 
    117 #   endif 
    118 #else 
    11955      ! ----------------------------------------- ! 
    12056      !     1. local variables initialization     ! 
    … …  
    212148      END DO 
    213149      ! 
     150#if ! defined key_mpi_off 
    214151      IF( ln_timing ) CALL tic_tac(.TRUE.) 
    215152      ! 
     153      icomm = mpi_comm_oce        ! shorter name 
    216154      ! non-blocking send of the western/eastern side using local temporary arrays 
    217       jn = jpwe   ;   IF( llsend(jn) )   CALL SENDROUTINE( 1, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) ) 
    218       jn = jpea   ;   IF( llsend(jn) )   CALL SENDROUTINE( 2, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) ) 
     155      jn = jpwe 
     156      IF( llsend(jn) )   CALL MPI_ISEND( zsnd(ishts(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 1, icomm, ireq(jn), ierr ) 
     157      jn = jpea 
     158      IF( llsend(jn) )   CALL MPI_ISEND( zsnd(ishts(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 2, icomm, ireq(jn), ierr ) 
    219159      ! blocking receive of the western/eastern halo in local temporary arrays 
    220       jn = jpwe   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 2, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) ) 
    221       jn = jpea   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 1, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) ) 
     160      jn = jpwe 
     161      IF( llrecv(jn) )   CALL MPI_RECV(  zrcv(ishtr(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 2, icomm, MPI_STATUS_IGNORE, ierr ) 
     162      jn = jpea 
     163      IF( llrecv(jn) )   CALL MPI_RECV(  zrcv(ishtr(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 1, icomm, MPI_STATUS_IGNORE, ierr ) 
    222164      ! 
    223165      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     166#endif 
    224167      ! 
    225168      ! ----------------------------------- ! 
    … …  
    264207      ! 
    265208      IF( ll_IdoNFold ) THEN 
    266          IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                     OPT_K(:) )   ! self NFold 
    267          ELSE                    ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:) )   ! mpi  NFold 
     209         IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, cd_nat, psgn                    , ipf )   ! self NFold 
     210         ELSE                    ;   CALL mpp_nfd( ptab, cd_nat, psgn, ifill(jpno), zland, ipf )   ! mpi  NFold 
    268211         ENDIF 
    269212      ENDIF 
    … …  
    284227      END DO 
    285228      ! 
     229#if ! defined key_mpi_off 
    286230      IF( ln_timing ) CALL tic_tac(.TRUE.) 
    287231      ! 
    288232      ! non-blocking send of the western/eastern side using local temporary arrays 
    289       jn = jpso   ;   IF( llsend(jn) )   CALL SENDROUTINE( 3, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) ) 
    290       jn = jpno   ;   IF( llsend(jn) )   CALL SENDROUTINE( 4, zsnd(ishts(jn)+1), iszall(jn), mpinei(jn), ireq(jn) ) 
     233      jn = jpso 
     234      IF( llsend(jn) )   CALL MPI_ISEND( zsnd(ishts(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 3, icomm, ireq(jn), ierr ) 
     235      jn = jpno 
     236      IF( llsend(jn) )   CALL MPI_ISEND( zsnd(ishts(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 4, icomm, ireq(jn), ierr ) 
    291237      ! blocking receive of the western/eastern halo in local temporary arrays 
    292       jn = jpso   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 4, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) ) 
    293       jn = jpno   ;   IF( llrecv(jn) )   CALL RECVROUTINE( 3, zrcv(ishtr(jn)+1), iszall(jn), mpinei(jn) ) 
     238      jn = jpso 
     239      IF( llrecv(jn) )   CALL MPI_RECV(  zrcv(ishtr(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 4, icomm, MPI_STATUS_IGNORE, ierr ) 
     240      jn = jpno 
     241      IF( llrecv(jn) )   CALL MPI_RECV(  zrcv(ishtr(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 3, icomm, MPI_STATUS_IGNORE, ierr ) 
    294242      ! 
    295243      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     244#endif 
    296245      ! 
    297246      ! ------------------------------------- ! 
    … …  
    335284      DEALLOCATE( zsnd, zrcv ) 
    336285      ! 
    337 #endif 
    338    END SUBROUTINE ROUTINE_LNK 
    339 #undef PRECISION 
    340 #undef SENDROUTINE 
    341 #undef RECVROUTINE 
    342 #undef ARRAY_TYPE 
    343 #undef NAT_IN 
    344 #undef SGN_IN 
     286   END SUBROUTINE lbc_lnk_pt2pt_/**/XD/**/_/**/PRECISION 
     287 
     288#undef XD 
    345289#undef ARRAY_IN 
    346290#undef K_SIZE 
    347291#undef L_SIZE 
    348292#undef F_SIZE 
    349 #undef OPT_K 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_ext_generic.h90

    r14336 r14338  
    1 !                          !==  IN: ptab is an array  ==! 
    2 #define NAT_IN(k)                cd_nat 
    3 #define SGN_IN(k)                psgn 
    4 #define F_SIZE(ptab)             1 
    51#if defined DIM_2d 
     2#   define XD                    2d 
    63#   define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    74#   define K_SIZE(ptab)          1 
    85#   define L_SIZE(ptab)          1 
     6#else 
     7=== NOT CODED === 
    98#endif 
    10 #if defined SINGLE_PRECISION 
    11 #   define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    12 #   define PRECISION sp 
    13 #else 
    14 #   define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    15 #   define PRECISION dp 
    16 #endif 
     9#define    F_SIZE(ptab)          1 
    1710 
    18    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj ) 
     11   SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION( ptab, cd_nat, psgn, kextj ) 
    1912      !!---------------------------------------------------------------------- 
    20       INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ARRAY_TYPE 
    21       ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied 
    22       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    23       REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     13      REAL(PRECISION), DIMENSION(:,1-kextj:),INTENT(inout) ::   ptab 
     14      CHARACTER(len=1), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     15      REAL(PRECISION),  INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     16      INTEGER,          INTENT(in   ) ::   kextj       ! extra halo width at north fold 
     17!!      INTEGER                       , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ptab 
    2418      ! 
    2519      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices 
    … …  
    3125      ipl = L_SIZE(ptab)   ! 4th    - 
    3226      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    33       ! 
    3427      ! 
    3528      SELECT CASE ( jpni ) 
    … …  
    4538         IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot 
    4639            ! 
    47             SELECT CASE ( NAT_IN(jf)  ) 
     40            SELECT CASE ( cd_nat  ) 
    4841            CASE ( 'T' , 'W' )                         ! T-, W-point 
    4942               DO jh = 0, kextj 
    5043                  DO ji = 2, jpiglo 
    5144                     ijt = jpiglo-ji+2 
    52                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
     45                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    5346                  END DO 
    54                   ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-2-jh,:,:,jf) 
     47                  ARRAY_IN(1,ipj+jh,:,:,jf) = psgn * ARRAY_IN(3,ipj-2-jh,:,:,jf) 
    5548               END DO 
    5649               DO ji = jpiglo/2+1, jpiglo 
    5750                  ijt = jpiglo-ji+2 
    58                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 
     51                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    5952               END DO 
    6053            CASE ( 'U' )                               ! U-point 
    … …  
    6255                  DO ji = 2, jpiglo-1 
    6356                     iju = jpiglo-ji+1 
    64                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
     57                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    6558                  END DO 
    66                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf) 
    67                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf)  
     59                 ARRAY_IN(   1  ,ipj+jh,:,:,jf) = psgn * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf) 
     60                 ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf)  
    6861               END DO 
    6962               DO ji = jpiglo/2, jpiglo-1 
    7063                  iju = jpiglo-ji+1 
    71                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 
     64                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(iju,ipjm1,:,:,jf) 
    7265               END DO 
    7366            CASE ( 'V' )                               ! V-point 
    … …  
    7568                  DO ji = 2, jpiglo 
    7669                     ijt = jpiglo-ji+2 
    77                      ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    78                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-3-jh,:,:,jf) 
     70                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
     71                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-3-jh,:,:,jf) 
    7972                  END DO 
    80                   ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-3-jh,:,:,jf)  
     73                  ARRAY_IN(1,ipj+jh,:,:,jf) = psgn * ARRAY_IN(3,ipj-3-jh,:,:,jf)  
    8174               END DO 
    8275            CASE ( 'F' )                               ! F-point 
    … …  
    8477                  DO ji = 1, jpiglo-1 
    8578                     iju = jpiglo-ji+1 
    86                      ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    87                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-3-jh,:,:,jf) 
     79                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
     80                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(iju,ipj-3-jh,:,:,jf) 
    8881                  END DO 
    8982               END DO 
    9083               DO jh = 0, kextj 
    91                   ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf) 
    92                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf) 
     84                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = psgn * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf) 
     85                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf) 
    9386               END DO 
    9487            END SELECT 
    … …  
    9891         IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot 
    9992            ! 
    100             SELECT CASE ( NAT_IN(jf)  ) 
     93            SELECT CASE ( cd_nat  ) 
    10194            CASE ( 'T' , 'W' )                         ! T-, W-point 
    10295               DO jh = 0, kextj 
    10396                  DO ji = 1, jpiglo 
    10497                     ijt = jpiglo-ji+1 
    105                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-1-jh,:,:,jf) 
     98                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-1-jh,:,:,jf) 
    10699                  END DO 
    107100               END DO 
    … …  
    110103                  DO ji = 1, jpiglo-1 
    111104                     iju = jpiglo-ji 
    112                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-1-jh,:,:,jf) 
     105                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-1-jh,:,:,jf) 
    113106                  END DO 
    114                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf) 
     107                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf) 
    115108               END DO 
    116109            CASE ( 'V' )                               ! V-point 
    … …  
    118111                  DO ji = 1, jpiglo 
    119112                     ijt = jpiglo-ji+1 
    120                      ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
     113                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf) 
    121114                  END DO 
    122115               END DO 
    123116               DO ji = jpiglo/2+1, jpiglo 
    124117                  ijt = jpiglo-ji+1 
    125                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 
     118                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    126119               END DO 
    127120            CASE ( 'F' )                               ! F-point 
    … …  
    129122                  DO ji = 1, jpiglo-1 
    130123                     iju = jpiglo-ji 
    131                      ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
     124                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf) 
    132125                  END DO 
    133                   ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf) 
     126                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf) 
    134127               END DO 
    135128               DO ji = jpiglo/2+1, jpiglo-1 
    136129                  iju = jpiglo-ji 
    137                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 
     130                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(iju,ipjm1,:,:,jf) 
    138131               END DO 
    139132            END SELECT 
    … …  
    143136      END DO 
    144137      ! 
    145    END SUBROUTINE ROUTINE_NFD 
     138   END SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION 
    146139 
    147 #undef PRECISION 
    148 #undef ARRAY_TYPE 
     140#undef XD 
    149141#undef ARRAY_IN 
    150 #undef NAT_IN 
    151 #undef SGN_IN 
    152142#undef K_SIZE 
    153143#undef L_SIZE 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_generic.h90

    r14336 r14338  
    1 #if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k)    
    3 #   define SGN_IN(k)                psgn(k) 
    4 #   define F_SIZE(ptab)             kfld 
    5 #   if defined DIM_2d 
    6 #      if defined SINGLE_PRECISION 
    7 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f) 
    8 #      else 
    9 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f) 
    10 #      endif 
    11 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    12 #      define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2) 
    13 #      define K_SIZE(ptab)             1 
    14 #      define L_SIZE(ptab)             1 
    15 #   endif 
    16 #   if defined DIM_3d 
    17 #      if defined SINGLE_PRECISION 
    18 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f) 
    19 #      else 
    20 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f) 
    21 #      endif 
    22 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    23 #      define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2) 
    24 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    25 #      define L_SIZE(ptab)             1 
    26 #   endif 
    27 #   if defined DIM_4d 
    28 #      if defined SINGLE_PRECISION 
    29 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f) 
    30 #      else 
    31 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f) 
    32 #      endif 
    33 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    34 #      define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2) 
    35 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    36 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    37 #   endif 
    38 #else 
    39 !                          !==  IN: ptab is an array  ==! 
    40 #   define NAT_IN(k)                cd_nat 
    41 #   define SGN_IN(k)                psgn 
    42 #   define F_SIZE(ptab)             1 
    43 #   if defined DIM_2d 
    44 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    45 #      define J_SIZE(ptab)          SIZE(ptab,2) 
    46 #      define K_SIZE(ptab)          1 
    47 #      define L_SIZE(ptab)          1 
    48 #   endif 
    49 #   if defined DIM_3d 
    50 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k) 
    51 #      define J_SIZE(ptab)          SIZE(ptab,2) 
    52 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    53 #      define L_SIZE(ptab)          1 
    54 #   endif 
    55 #   if defined DIM_4d 
    56 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l) 
    57 #      define J_SIZE(ptab)          SIZE(ptab,2) 
    58 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    59 #      define L_SIZE(ptab)          SIZE(ptab,4) 
    60 #   endif 
    61 #   if defined SINGLE_PRECISION 
    62 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    63 #   else 
    64 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    65 #   endif 
     1#if defined DIM_2d 
     2#   define XD                       2d 
     3#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
     4#   define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2) 
     5#   define K_SIZE(ptab)             1 
     6#   define L_SIZE(ptab)             1 
    667#endif 
     8#if defined DIM_3d 
     9#   define XD                       3d 
     10#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
     11#   define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2) 
     12#   define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
     13#   define L_SIZE(ptab)             1 
     14#endif 
     15#if defined DIM_4d 
     16#   define XD                       4d 
     17#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
     18#   define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2) 
     19#   define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
     20#   define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
     21#endif 
     22#define    F_SIZE(ptab)             kfld 
    6723 
    68 #   if defined SINGLE_PRECISION 
    69 #      define PRECISION sp 
    70 #   else 
    71 #      define PRECISION dp 
    72 #   endif 
    73  
    74 #if defined MULTI 
    75    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 
    76       INTEGER          , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    77 #else 
    78    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn       ) 
    79 #endif 
    80       ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied 
    81       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    82       REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     24   SUBROUTINE lbc_nfd_/**/XD/**/_/**/PRECISION( ptab, cd_nat, psgn, kfld ) 
     25      TYPE(PTR_/**/XD/**/_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c. 
     26      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     27      REAL(PRECISION),  DIMENSION(:), INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     28      INTEGER                       , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    8329      ! 
    8430      INTEGER  ::    ji,  jj,  jk,  jl,  jf   ! dummy loop indices 
    … …  
    9642         IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot 
    9743            ! 
    98             SELECT CASE ( NAT_IN(jf) ) 
     44            SELECT CASE ( cd_nat(jf) ) 
    9945            CASE ( 'T' , 'W' )                         ! T-, W-point 
    10046               DO jl = 1, ipl; DO jk = 1, ipk 
    … …  
    10854                        ii1 =                ji          ! ends at: nn_hls 
    10955                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
    110                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     56                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    11157                     END DO 
    11258                     DO ji = 1, 1                 ! point nn_hls+1 
    11359                        ii1 = nn_hls + ji 
    11460                        ii2 = ii1 
    115                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     61                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    11662                     END DO 
    11763                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    11864                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 
    11965                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 
    120                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     66                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    12167                     END DO 
    12268                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1 
    12369                        ii1 = jpiglo - nn_hls + ji 
    12470                        ii2 =          nn_hls + ji 
    125                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     71                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    12672                     END DO 
    12773                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points 
    12874                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 
    12975                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 
    130                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     76                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    13177                     END DO 
    13278                  END DO 
    … …  
    14086                        ii1 = jpiglo/2 + ji + 1          ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls 
    14187                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2 
    142                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     88                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    14389                     END DO 
    14490                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
    … …  
    14692                        ii1 =                ji          ! ends at: nn_hls 
    14793                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
    148                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     94                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    14995                     END DO 
    15096                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
    … …  
    163109                        ii1 =                ji          ! ends at: nn_hls 
    164110                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    165                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     111                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    166112                     END DO 
    167113                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    168114                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
    169115                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
    170                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     116                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    171117                     END DO 
    172118                     DO ji = 1, nn_hls            ! last nn_hls points 
    173119                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    174120                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
    175                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     121                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    176122                     END DO 
    177123                  END DO 
    … …  
    185131                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
    186132                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 
    187                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     133                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    188134                     END DO 
    189135                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
    … …  
    191137                        ii1 =                ji          ! ends at: nn_hls 
    192138                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    193                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     139                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    194140                     END DO 
    195141                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
    … …  
    208154                        ii1 =                ji          ! ends at: nn_hls 
    209155                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
    210                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     156                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    211157                     END DO 
    212158                     DO ji = 1, 1                 ! point nn_hls+1 
    213159                        ii1 = nn_hls + ji 
    214160                        ii2 = ii1 
    215                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     161                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    216162                     END DO 
    217163                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    218164                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 
    219165                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 
    220                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     166                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    221167                     END DO 
    222168                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1 
    223169                        ii1 = jpiglo - nn_hls + ji 
    224170                        ii2 =          nn_hls + ji 
    225                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     171                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    226172                     END DO 
    227173                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points 
    228174                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 
    229175                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 
    230                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     176                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    231177                     END DO 
    232178                  END DO 
    … …  
    244190                        ii1 =                ji          ! ends at: nn_hls 
    245191                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    246                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     192                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    247193                     END DO 
    248194                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    249195                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
    250196                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
    251                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     197                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    252198                     END DO 
    253199                     DO ji = 1, nn_hls            ! last nn_hls points 
    254200                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    255201                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
    256                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    257                      END DO 
    258                   END DO 
    259                   ! 
    260                END DO; END DO 
    261             END SELECT   ! NAT_IN(jf) 
     202                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     203                     END DO 
     204                  END DO 
     205                  ! 
     206               END DO; END DO 
     207            END SELECT   ! cd_nat(jf) 
    262208            ! 
    263209         ENDIF   ! c_NFtype == 'T' 
    … …  
    265211         IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot 
    266212            ! 
    267             SELECT CASE ( NAT_IN(jf) ) 
     213            SELECT CASE ( cd_nat(jf) ) 
    268214            CASE ( 'T' , 'W' )                         ! T-, W-point 
    269215               DO jl = 1, ipl; DO jk = 1, ipk 
    … …  
    300246                        ii1 =                ji          ! ends at: nn_hls 
    301247                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    302                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     248                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    303249                     END DO 
    304250                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    305251                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
    306252                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
    307                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     253                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    308254                     END DO 
    309255                     DO ji = 1, nn_hls            ! last nn_hls points 
    310256                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    311257                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
    312                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     258                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    313259                     END DO 
    314260                  END DO 
    … …  
    326272                        ii1 =            ji              ! ends at: nn_hls-1 
    327273                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
    328                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     274                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    329275                     END DO 
    330276                     DO ji = 1, 1                 ! point nn_hls 
    331277                        ii1 = nn_hls + ji - 1 
    332278                        ii2 = jpiglo - ii1 
    333                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     279                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    334280                     END DO 
    335281                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls) 
    336282                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 
    337283                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 
    338                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     284                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    339285                     END DO 
    340286                     DO ji = 1, 1                 ! point jpiglo - nn_hls 
    341287                        ii1 = jpiglo - nn_hls + ji - 1 
    342288                        ii2 = ii1 
    343                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     289                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    344290                     END DO 
    345291                     DO ji = 1, nn_hls            ! last nn_hls points 
    346292                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    347293                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 
    348                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     294                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    349295                     END DO 
    350296                  END DO 
    … …  
    362308                        ii1 =                ji          ! ends at: nn_hls 
    363309                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    364                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     310                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    365311                     END DO 
    366312                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
    367313                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
    368314                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
    369                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     315                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    370316                     END DO 
    371317                     DO ji = 1, nn_hls            ! last nn_hls points 
    372318                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    373319                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
    374                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     320                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    375321                     END DO 
    376322                  END DO    
    … …  
    384330                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
    385331                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 
    386                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     332                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    387333                     END DO 
    388334                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
    … …  
    390336                        ii1 =                ji          ! ends at: nn_hls 
    391337                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
    392                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     338                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    393339                     END DO 
    394340                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
    … …  
    407353                        ii1 =            ji              ! ends at: nn_hls-1 
    408354                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
    409                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     355                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    410356                     END DO 
    411357                     DO ji = 1, 1                 ! point nn_hls 
    412358                        ii1 = nn_hls + ji - 1 
    413359                        ii2 = jpiglo - ii1 
    414                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     360                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    415361                     END DO 
    416362                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls) 
    417363                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 
    418364                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 
    419                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     365                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    420366                     END DO 
    421367                     DO ji = 1, 1                 ! point jpiglo - nn_hls 
    422368                        ii1 = jpiglo - nn_hls + ji - 1 
    423369                        ii2 = ii1 
    424                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     370                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    425371                     END DO 
    426372                     DO ji = 1, nn_hls            ! last nn_hls points 
    427373                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
    428374                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 
    429                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     375                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    430376                     END DO 
    431377                  END DO    
    … …  
    439385                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
    440386                        ii2 = jpiglo/2 - ji              ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1 
    441                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     387                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    442388                     END DO 
    443389                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done) 
    … …  
    445391                        ii1 =            ji              ! ends at: nn_hls 
    446392                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
    447                         ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     393                        ARRAY_IN(ii1,ij1,jk,jl,jf) = psgn(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    448394                     END DO 
    449395                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
    … …  
    451397                  ! 
    452398               END DO; END DO 
    453             END SELECT   ! NAT_IN(jf) 
     399            END SELECT   ! cd_nat(jf) 
    454400            ! 
    455401         ENDIF   ! c_NFtype == 'F' 
    … …  
    457403      END DO   ! ipf 
    458404      ! 
    459    END SUBROUTINE ROUTINE_NFD 
     405   END SUBROUTINE lbc_nfd_/**/XD/**/_/**/PRECISION 
    460406 
    461 #undef PRECISION 
    462 #undef ARRAY_TYPE 
     407#undef XD 
    463408#undef ARRAY_IN 
    464 #undef NAT_IN 
    465 #undef SGN_IN 
    466409#undef J_SIZE 
    467410#undef K_SIZE 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r14336 r14338  
    1 #if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k)    
    3 #   define SGN_IN(k)                psgn(k) 
    4 #   define F_SIZE(ptab)             kfld 
    5 #   if defined DIM_2d 
    6 #      if defined SINGLE_PRECISION 
    7 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f) 
    8 #      else 
    9 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f) 
    10 #      endif  
    11 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    12 #      define K_SIZE(ptab)             1 
    13 #      define L_SIZE(ptab)             1 
    14 #   endif 
    15 #   if defined DIM_3d 
    16 #      if defined SINGLE_PRECISION 
    17 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f) 
    18 #      else 
    19 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f) 
    20 #      endif  
    21 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    22 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    23 #      define L_SIZE(ptab)             1 
    24 #   endif 
    25 #   if defined DIM_4d 
    26 #      if defined SINGLE_PRECISION 
    27 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f) 
    28 #      else 
    29 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f) 
    30 #      endif  
    31 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    32 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    33 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    34 #   endif 
    35 #   if defined SINGLE_PRECISION 
    36 #      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f) 
    37 #   else 
    38 #      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f) 
    39 #   endif 
    40 #   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2) 
    41 #   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l) 
    42 #else 
    43 !                          !==  IN: ptab is an array  ==! 
    44 #   define NAT_IN(k)                cd_nat 
    45 #   define SGN_IN(k)                psgn 
    46 #   define F_SIZE(ptab)             1 
    47 #   if defined DIM_2d 
    48 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    49 #      define K_SIZE(ptab)          1 
    50 #      define L_SIZE(ptab)          1 
    51 #   endif 
    52 #   if defined DIM_3d 
    53 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k) 
    54 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    55 #      define L_SIZE(ptab)          1 
    56 #   endif 
    57 #   if defined DIM_4d 
    58 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l) 
    59 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    60 #      define L_SIZE(ptab)          SIZE(ptab,4) 
    61 #   endif 
    62 #   define J_SIZE(ptab2)             SIZE(ptab2,2) 
    63 #   define ARRAY2_IN(i,j,k,l,f)   ptab2(i,j,k,l) 
    64 #   if defined SINGLE_PRECISION 
    65 #      define ARRAY_TYPE(i,j,k,l,f)     REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    66 #      define ARRAY2_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 
    67 #   else 
    68 #      define ARRAY_TYPE(i,j,k,l,f)     REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    69 #      define ARRAY2_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 
    70 #   endif 
    71 #   endif 
    72 #   ifdef SINGLE_PRECISION 
    73 #      define PRECISION sp 
    74 #   else 
    75 #      define PRECISION dp 
    76 #   endif 
    77    SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld ) 
     1#if defined DIM_2d 
     2#   define XD                       2d 
     3#   define DIMS_IN                  :,: 
     4#   define ARRAY_IN(i,j,k,l)        ptab(i,j) 
     5#   define K_SIZE(ptab)             1 
     6#   define L_SIZE(ptab)             1 
     7#endif 
     8#if defined DIM_3d 
     9#   define XD                       3d 
     10#   define DIMS_IN                  :,:,: 
     11#   define ARRAY_IN(i,j,k,l)        ptab(i,j,k) 
     12#   define K_SIZE(ptab)             SIZE(ptab,3) 
     13#   define L_SIZE(ptab)             1 
     14#endif 
     15#if defined DIM_4d 
     16#   define XD                       4d 
     17#   define DIMS_IN                  :,:,:,: 
     18#   define ARRAY_IN(i,j,k,l)        ptab(i,j,k,l) 
     19#   define K_SIZE(ptab)             SIZE(ptab,3) 
     20#   define L_SIZE(ptab)             SIZE(ptab,4) 
     21#endif 
     22 
     23   SUBROUTINE lbc_nfd_nogather_/**/XD/**/_/**/PRECISION( ptab, ptab2, cd_nat, psgn ) 
    7824      !!---------------------------------------------------------------------- 
    7925      !! 
    … …  
    8228      !! 
    8329      !!---------------------------------------------------------------------- 
    84       ARRAY_TYPE(:,:,:,:,:) 
    85       ARRAY2_TYPE(:,:,:,:,:)  
    86       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    87       REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    88       INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays 
     30      REAL(PRECISION),  DIMENSION(DIMS_IN), INTENT(inout) :: ptab          !  
     31      REAL(PRECISION),  DIMENSION(:,:,:,:), INTENT(inout) :: ptab2          !  
     32      CHARACTER(len=1), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     33      REAL(PRECISION),  INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
    8934      ! 
    90       INTEGER  ::    ji,  jj,   jk, jn, ii,   jl,   jh,  jf   ! dummy loop indices 
    91       INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf, iij, ijj   ! dimension of the input array 
     35      INTEGER  ::    ji,  jj, jk,  jn,  jl, jh       ! dummy loop indices 
     36      INTEGER  ::   ipk, ipl, ii, iij, ijj      ! dimension of the input array 
    9237      INTEGER  ::   ijt, iju, ijta, ijua, jia, startloop, endloop 
    9338      LOGICAL  ::   l_fast_exchanges 
    9439      !!---------------------------------------------------------------------- 
    95       ipj = J_SIZE(ptab2)  ! 2nd dimension of input array 
    9640      ipk = K_SIZE(ptab)   ! 3rd dimension of output array 
    9741      ipl = L_SIZE(ptab)   ! 4th    - 
    98       ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    9942      ! 
    100       ! Security check for further developments 
    101       IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 
    10243      ! 2nd dimension determines exchange speed 
    103       IF (ipj == 1 ) THEN 
     44      IF ( SIZE(ptab2,2) == 1 ) THEN 
    10445        l_fast_exchanges = .TRUE. 
    10546      ELSE 
    10647        l_fast_exchanges = .FALSE. 
    10748      ENDIF 
    108       ! 
    109       DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
    11049         ! 
    11150         IF( c_NFtype == 'T' ) THEN          ! *  North fold  T-point pivot 
    11251            ! 
    113             SELECT CASE ( NAT_IN(jf) ) 
     52            SELECT CASE ( cd_nat ) 
    11453            ! 
    11554            CASE ( 'T' , 'W' )                         ! T-, W-point 
    … …  
    12362                     DO ji = startloop, jpi 
    12463                     ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
    125                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     64                        ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl) 
    12665                     END DO 
    12766                  END DO 
    … …  
    13271                     ijj = jpj -jj +1 
    13372                     DO ii = 0, nn_hls-1 
    134                         ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
     73                        ARRAY_IN(ii+1,ijj,jk,jl) = psgn * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl) 
    13574                     END DO 
    13675                     END DO 
    … …  
    15392                           ijta = jpiglo - jia + 2 
    15493                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    155                               ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 
     94                              ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl) 
    15695                           ELSE 
    157                               ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     96                              ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ptab2(ijt,nn_hls+1,jk,jl) 
    15897                           ENDIF 
    15998                        END DO 
    … …  
    172111                     DO ji = 1, endloop 
    173112                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    174                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     113                        ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl) 
    175114                     END DO 
    176115                  END DO 
    … …  
    180119           ijj = jpj -jj +1 
    181120           DO ii = 0, nn_hls-1 
    182          ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     121         ARRAY_IN(ii+1,ijj,:,:) = psgn * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:) 
    183122           END DO 
    184123                  END DO 
    … …  
    188127                       ijj = jpj -jj +1 
    189128         DO ii = 1, nn_hls 
    190                ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     129               ARRAY_IN(jpi-ii+1,ijj,:,:) = psgn * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:) 
    191130         END DO 
    192131        END DO 
    … …  
    213152                        ijua = jpiglo - jia + 1  
    214153                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    215                            ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf) 
     154                           ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl) 
    216155                        ELSE 
    217                            ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     156                           ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ptab2(iju,nn_hls+1,jk,jl) 
    218157                        ENDIF 
    219158                     END DO 
    … …  
    234173                        DO ji = startloop, jpi 
    235174                           ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
    236                            ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     175                           ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl) 
    237176                        END DO 
    238177                    END DO 
    … …  
    242181                  DO ji = startloop, jpi 
    243182                     ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
    244                      ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
     183                     ARRAY_IN(ji,jpj,jk,jl) = psgn * ptab2(ijt,1,jk,jl) 
    245184                  END DO 
    246185               END DO; END DO 
    … …  
    249188                       ijj = jpj-jj+1 
    250189                       DO ii = 0, nn_hls-1 
    251                         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 
     190                        ARRAY_IN(ii+1,ijj,:,:) = psgn * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:) 
    252191           END DO 
    253192        END DO 
    … …  
    265204                        DO ji = 1, endloop 
    266205                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    267                            ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     206                           ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl) 
    268207                        END DO 
    269208                    END DO 
    … …  
    273212                  DO ji = 1, endloop 
    274213                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    275                      ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
     214                     ARRAY_IN(ji,jpj,jk,jl) = psgn * ptab2(iju,1,jk,jl) 
    276215                  END DO 
    277216               END DO; END DO 
    278217      IF (nimpp .eq. 1) THEN                
    279218         DO ii = 1, nn_hls 
    280                  ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 
     219                 ARRAY_IN(ii,jpj,:,:) = psgn * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:) 
    281220         END DO 
    282221         IF ( .NOT. l_fast_exchanges ) THEN 
    … …  
    284223                      ijj = jpj -jj 
    285224                      DO ii = 0, nn_hls-1 
    286                          ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     225                         ARRAY_IN(ii+1,ijj,:,:) = psgn * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:) 
    287226                   END DO 
    288227                      END DO 
    … …  
    291230      IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 
    292231                   DO ii = 1, nn_hls 
    293                  ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 
     232                 ARRAY_IN(jpi-ii+1,jpj,:,:) = psgn * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:) 
    294233         END DO 
    295234         IF ( .NOT. l_fast_exchanges ) THEN 
    … …  
    297236                           ijj = jpj -jj 
    298237                      DO ii = 1, nn_hls 
    299                          ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     238                         ARRAY_IN(jpi-ii+1,ijj,:,:) = psgn * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:) 
    300239                         END DO 
    301240                      END DO 
    … …  
    309248         IF( c_NFtype == 'F' ) THEN           ! *  North fold  F-point pivot 
    310249            ! 
    311             SELECT CASE ( NAT_IN(jf) ) 
     250            SELECT CASE ( cd_nat ) 
    312251            CASE ( 'T' , 'W' )                               ! T-, W-point 
    313252               DO jl = 1, ipl; DO jk = 1, ipk 
    … …  
    316255           DO ji = 1, jpi 
    317256                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    318                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     257                        ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl) 
    319258                     END DO 
    320259        END DO 
    … …  
    332271                     DO ji = 1, endloop 
    333272                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
    334                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     273                        ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(iju,jj,jk,jl) 
    335274                     END DO 
    336275                  END DO 
    … …  
    342281                        DO ii = 1, nn_hls 
    343282            iij = jpi-ii+1 
    344                            ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf) 
     283                           ARRAY_IN(iij,ijj,jk,jl) = psgn * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl) 
    345284                        END DO 
    346285                     END DO 
    … …  
    354293                     DO ji = 1, jpi 
    355294                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    356                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     295                        ARRAY_IN(ji,ijj,jk,jl) = psgn * ptab2(ijt,jj,jk,jl) 
    357296                     END DO 
    358297                  END DO 
    … …  
    371310                        DO ji = startloop, jpi 
    372311                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
    373                            ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     312                           ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ptab2(ijt,nn_hls+1,jk,jl) 
    374313                        END DO 
    375314                  END DO; END DO 
    … …  
    388327                    DO ji = 1, endloop 
    389328                       iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
    390                        ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     329                       ARRAY_IN(ji,ijj ,jk,jl) = psgn * ptab2(iju,jj,jk,jl) 
    391330                     END DO 
    392331                  END DO 
    … …  
    398337                        DO ii = 1, nn_hls 
    399338            iij = jpi -ii+1 
    400                            ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
     339                           ARRAY_IN(iij,ijj,jk,jl) = psgn * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl) 
    401340                        END DO 
    402341                     END DO 
    … …  
    421360                        DO ji = startloop, endloop 
    422361                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
    423                            ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     362                           ARRAY_IN(ji,jpj-nn_hls,jk,jl) = psgn * ptab2(iju,nn_hls+1,jk,jl) 
    424363                        END DO 
    425364                     END DO; END DO 
    … …  
    431370         ENDIF   ! c_NFtype == 'F' 
    432371         ! 
    433       END DO            ! End jf loop 
    434    END SUBROUTINE ROUTINE_NFD 
    435 #undef PRECISION 
    436 #undef ARRAY_TYPE 
     372   END SUBROUTINE lbc_nfd_nogather_/**/XD/**/_/**/PRECISION 
     373 
     374#undef XD 
     375#undef DIMS_IN 
    437376#undef ARRAY_IN 
    438 #undef NAT_IN 
    439 #undef SGN_IN 
    440 #undef J_SIZE 
    441377#undef K_SIZE 
    442378#undef L_SIZE 
    443 #undef F_SIZE 
    444 #undef ARRAY2_TYPE 
    445 #undef ARRAY2_IN 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbclnk.F90

    r14314 r14338  
    2323   USE lbcnfd         ! north fold 
    2424   USE in_out_manager ! I/O manager 
     25#if ! defined key_mpi_off 
     26   USE MPI 
     27#endif 
    2528 
    2629   IMPLICIT NONE 
    … …  
    2831 
    2932   INTERFACE lbc_lnk 
    30       MODULE PROCEDURE   mpp_lnk_2d_sp   , mpp_lnk_3d_sp   , mpp_lnk_4d_sp 
    31       MODULE PROCEDURE   mpp_lnk_2d_dp   , mpp_lnk_3d_dp   , mpp_lnk_4d_dp 
    32    END INTERFACE 
    33    INTERFACE lbc_lnk_ptr 
    34       MODULE PROCEDURE   mpp_lnk_2d_ptr_sp , mpp_lnk_3d_ptr_sp , mpp_lnk_4d_ptr_sp 
    35       MODULE PROCEDURE   mpp_lnk_2d_ptr_dp , mpp_lnk_3d_ptr_dp , mpp_lnk_4d_ptr_dp 
    36    END INTERFACE 
    37    INTERFACE lbc_lnk_multi 
    38       MODULE PROCEDURE   lbc_lnk_2d_multi_sp , lbc_lnk_3d_multi_sp, lbc_lnk_4d_multi_sp 
    39       MODULE PROCEDURE   lbc_lnk_2d_multi_dp , lbc_lnk_3d_multi_dp, lbc_lnk_4d_multi_dp 
    40    END INTERFACE 
    41    INTERFACE lbc_lnk_nc_multi 
    42       MODULE PROCEDURE   lbc_lnk_nc_2d_sp, lbc_lnk_nc_3d_sp, lbc_lnk_nc_4d_sp 
    43       MODULE PROCEDURE   lbc_lnk_nc_2d_dp, lbc_lnk_nc_3d_dp, lbc_lnk_nc_4d_dp 
    44    END INTERFACE 
    45    INTERFACE lbc_lnk_nc 
    46       MODULE PROCEDURE   mpp_lnk_nc_2d_sp, mpp_lnk_nc_3d_sp, mpp_lnk_nc_4d_sp 
    47       MODULE PROCEDURE   mpp_lnk_nc_2d_dp, mpp_lnk_nc_3d_dp, mpp_lnk_nc_4d_dp 
     33      MODULE PROCEDURE   lbc_lnk_call_2d_sp, lbc_lnk_call_3d_sp, lbc_lnk_call_4d_sp 
     34      MODULE PROCEDURE   lbc_lnk_call_2d_dp, lbc_lnk_call_3d_dp, lbc_lnk_call_4d_dp 
     35   END INTERFACE 
     36 
     37   INTERFACE lbc_lnk_pt2pt 
     38      MODULE PROCEDURE   lbc_lnk_pt2pt_2d_sp , lbc_lnk_pt2pt_3d_sp , lbc_lnk_pt2pt_4d_sp 
     39      MODULE PROCEDURE   lbc_lnk_pt2pt_2d_dp , lbc_lnk_pt2pt_3d_dp , lbc_lnk_pt2pt_4d_dp 
     40   END INTERFACE 
     41 
     42   INTERFACE lbc_lnk_neicoll 
     43      MODULE PROCEDURE   lbc_lnk_neicoll_2d_sp , lbc_lnk_neicoll_3d_sp , lbc_lnk_neicoll_4d_sp 
     44      MODULE PROCEDURE   lbc_lnk_neicoll_2d_dp , lbc_lnk_neicoll_3d_dp , lbc_lnk_neicoll_4d_dp 
    4845   END INTERFACE 
    4946   ! 
    … …  
    5249   END INTERFACE 
    5350 
    54    INTERFACE mpp_nfd 
    55       MODULE PROCEDURE   mpp_nfd_2d_sp    , mpp_nfd_3d_sp    , mpp_nfd_4d_sp 
    56       MODULE PROCEDURE   mpp_nfd_2d_dp    , mpp_nfd_3d_dp    , mpp_nfd_4d_dp 
    57       MODULE PROCEDURE   mpp_nfd_2d_ptr_sp, mpp_nfd_3d_ptr_sp, mpp_nfd_4d_ptr_sp 
    58       MODULE PROCEDURE   mpp_nfd_2d_ptr_dp, mpp_nfd_3d_ptr_dp, mpp_nfd_4d_ptr_dp 
    59  
    60    END INTERFACE 
    61  
    6251   PUBLIC   lbc_lnk            ! ocean/ice lateral boundary conditions 
    63    PUBLIC   lbc_lnk_multi      ! modified ocean/ice lateral boundary conditions 
    6452   PUBLIC   lbc_lnk_icb        ! iceberg lateral boundary conditions 
    65    PUBLIC   lbc_lnk_nc         ! ocean/ice lateral boundary conditions (MPI3 version) 
    66    PUBLIC   lbc_lnk_nc_multi   ! modified ocean/ice lateral boundary conditions (MPI3 version) 
    67  
    68 #if ! defined key_mpi_off 
    69 !$AGRIF_DO_NOT_TREAT 
    70    INCLUDE 'mpif.h' 
    71 !$AGRIF_END_DO_NOT_TREAT 
    72 #endif 
    73  
    74    INTEGER, PUBLIC, PARAMETER ::   jpfillnothing = 1 
    75    INTEGER, PUBLIC, PARAMETER ::   jpfillcst     = 2 
    76    INTEGER, PUBLIC, PARAMETER ::   jpfillcopy    = 3 
    77    INTEGER, PUBLIC, PARAMETER ::   jpfillperio   = 4 
    78    INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5 
    7953 
    8054   !! * Substitutions 
    … …  
    8862 
    8963   !!---------------------------------------------------------------------- 
    90    !!                   ***   load_ptr_(2,3,4)d   *** 
     64   !!                   ***   lbc_lnk_call_[234]d_[sd]p   *** 
    9165   !! 
    9266   !!   * Dummy Argument : 
    93    !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D) 
     67   !!       in    ==>   cdname     ! name of the calling subroutine (for monitoring) 
     68   !!                   ptab       ! array to be loaded (2D, 3D or 4D) 
    9469   !!                   cd_nat     ! nature of pt2d array grid-points 
    9570   !!                   psgn       ! sign used across the north fold boundary 
    … …  
    9974   !!                   kfld       ! number of elements that has been attributed 
    10075   !!---------------------------------------------------------------------- 
    101  
    102    !!---------------------------------------------------------------------- 
    103    !!                  ***   lbc_lnk_(2,3,4)d_multi   *** 
    104    !!                     ***   load_ptr_(2,3,4)d   *** 
    105    !! 
    106    !!   * Argument : dummy argument use in lbc_lnk_multi_... routines 
    107    !! 
    108    !!---------------------------------------------------------------------- 
    109  
     76   ! 
     77   !!---------------------------------------------------------------------- 
     78   !! 
     79   !!                  ***   lbc_lnk_call_[234]d_[sd]p   *** 
     80   !!                  ***     load_ptr_[234]d_[sd]p     *** 
     81   !! 
     82   !!---------------------------------------------------------------------- 
    11083   !! 
    11184   !!   ----   SINGLE PRECISION VERSIONS 
    11285   !! 
    113 #  define SINGLE_PRECISION 
    114 #  define DIM_2d 
    115 #     define ROUTINE_LOAD           load_ptr_2d_sp 
    116 #     define ROUTINE_MULTI          lbc_lnk_2d_multi_sp 
    117 #     include "lbc_lnk_multi_generic.h90" 
    118 #     undef ROUTINE_MULTI 
    119 #     undef ROUTINE_LOAD 
    120 #  undef DIM_2d 
    121  
    122 #  define DIM_3d 
    123 #     define ROUTINE_LOAD           load_ptr_3d_sp 
    124 #     define ROUTINE_MULTI          lbc_lnk_3d_multi_sp 
    125 #     include "lbc_lnk_multi_generic.h90" 
    126 #     undef ROUTINE_MULTI 
    127 #     undef ROUTINE_LOAD 
    128 #  undef DIM_3d 
    129  
    130 #  define DIM_4d 
    131 #     define ROUTINE_LOAD           load_ptr_4d_sp 
    132 #     define ROUTINE_MULTI          lbc_lnk_4d_multi_sp 
    133 #     include "lbc_lnk_multi_generic.h90" 
    134 #     undef ROUTINE_MULTI 
    135 #     undef ROUTINE_LOAD 
    136 #  undef DIM_4d 
    137 #  undef SINGLE_PRECISION 
     86#define PRECISION sp 
     87# define DIM_2d 
     88#    include "lbc_lnk_call_generic.h90" 
     89# undef  DIM_2d 
     90# define DIM_3d 
     91#    include "lbc_lnk_call_generic.h90" 
     92# undef  DIM_3d 
     93# define DIM_4d 
     94#    include "lbc_lnk_call_generic.h90" 
     95# undef  DIM_4d 
     96#undef PRECISION 
    13897   !! 
    13998   !!   ----   DOUBLE PRECISION VERSIONS 
    14099   !! 
    141  
    142 #  define DIM_2d 
    143 #     define ROUTINE_LOAD           load_ptr_2d_dp 
    144 #     define ROUTINE_MULTI          lbc_lnk_2d_multi_dp 
    145 #     include "lbc_lnk_multi_generic.h90" 
    146 #     undef ROUTINE_MULTI 
    147 #     undef ROUTINE_LOAD 
    148 #  undef DIM_2d 
    149  
    150 #  define DIM_3d 
    151 #     define ROUTINE_LOAD           load_ptr_3d_dp 
    152 #     define ROUTINE_MULTI          lbc_lnk_3d_multi_dp 
    153 #     include "lbc_lnk_multi_generic.h90" 
    154 #     undef ROUTINE_MULTI 
    155 #     undef ROUTINE_LOAD 
    156 #  undef DIM_3d 
    157  
    158 #  define DIM_4d 
    159 #     define ROUTINE_LOAD           load_ptr_4d_dp 
    160 #     define ROUTINE_MULTI          lbc_lnk_4d_multi_dp 
    161 #     include "lbc_lnk_multi_generic.h90" 
    162 #     undef ROUTINE_MULTI 
    163 #     undef ROUTINE_LOAD 
    164 #  undef DIM_4d 
    165  
    166    !!---------------------------------------------------------------------- 
    167    !!                   ***  routine mpp_lnk_(2,3,4)d  *** 
    168    !! 
    169    !!   * Argument : dummy argument use in mpp_lnk_... routines 
    170    !!                ptab      :   array or pointer of arrays on which the boundary condition is applied 
     100#define PRECISION dp 
     101# define DIM_2d 
     102#    include "lbc_lnk_call_generic.h90" 
     103# undef  DIM_2d 
     104# define DIM_3d 
     105#    include "lbc_lnk_call_generic.h90" 
     106# undef  DIM_3d 
     107# define DIM_4d 
     108#    include "lbc_lnk_call_generic.h90" 
     109# undef  DIM_4d 
     110#undef PRECISION 
     111   ! 
     112   !!---------------------------------------------------------------------- 
     113   !!                   ***  lbc_lnk_pt2pt_[234]d_[sd]p  *** 
     114   !!                  ***  lbc_lnk_neicoll_[234]d_[sd]p  *** 
     115   !! 
     116   !!   * Argument : dummy argument use in lbc_lnk_... routines 
     117   !!                cdname    :   name of the calling subroutine (for monitoring) 
     118   !!                ptab      :   pointer of arrays on which the boundary condition is applied 
    171119   !!                cd_nat    :   nature of array grid-points 
    172120   !!                psgn      :   sign used across the north fold boundary 
    173    !!                kfld      :   optional, number of pt3d arrays 
     121   !!                kfld      :   number of pt3d arrays 
    174122   !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables) 
    175123   !!                pfillval  :   optional, background value (used with jpfillcopy) 
    176124   !!---------------------------------------------------------------------- 
    177    ! 
    178    !                       !==  2D array and array of 2D pointer  ==! 
    179    ! 
    180125   !! 
    181126   !!   ----   SINGLE PRECISION VERSIONS 
    182127   !! 
    183 # define SINGLE_PRECISION 
    184 #  define DIM_2d 
    185 #     define ROUTINE_LNK           mpp_lnk_2d_sp 
    186 #     include "mpp_lnk_generic.h90" 
    187 #     undef ROUTINE_LNK 
    188 #     define MULTI 
    189 #     define ROUTINE_LNK           mpp_lnk_2d_ptr_sp 
    190 #     include "mpp_lnk_generic.h90" 
    191 #     undef ROUTINE_LNK 
    192 #     undef MULTI 
    193 #  undef DIM_2d 
    194    ! 
    195    !                       !==  3D array and array of 3D pointer  ==! 
    196    ! 
    197 #  define DIM_3d 
    198 #     define ROUTINE_LNK           mpp_lnk_3d_sp 
    199 #     include "mpp_lnk_generic.h90" 
    200 #     undef ROUTINE_LNK 
    201 #     define MULTI 
    202 #     define ROUTINE_LNK           mpp_lnk_3d_ptr_sp 
    203 #     include "mpp_lnk_generic.h90" 
    204 #     undef ROUTINE_LNK 
    205 #     undef MULTI 
    206 #  undef DIM_3d 
    207    ! 
    208    !                       !==  4D array and array of 4D pointer  ==! 
    209    ! 
    210 #  define DIM_4d 
    211 #     define ROUTINE_LNK           mpp_lnk_4d_sp 
    212 #     include "mpp_lnk_generic.h90" 
    213 #     undef ROUTINE_LNK 
    214 #     define MULTI 
    215 #     define ROUTINE_LNK           mpp_lnk_4d_ptr_sp 
    216 #     include "mpp_lnk_generic.h90" 
    217 #     undef ROUTINE_LNK 
    218 #     undef MULTI 
    219 #  undef DIM_4d 
    220 # undef SINGLE_PRECISION 
    221  
     128#define PRECISION sp 
     129# define MPI_TYPE MPI_REAL 
     130# define DIM_2d 
     131#    include "lbc_lnk_pt2pt_generic.h90" 
     132#    include "lbc_lnk_neicoll_generic.h90" 
     133# undef DIM_2d 
     134# define DIM_3d 
     135#    include "lbc_lnk_pt2pt_generic.h90" 
     136#    include "lbc_lnk_neicoll_generic.h90" 
     137# undef DIM_3d 
     138# define DIM_4d 
     139#    include "lbc_lnk_pt2pt_generic.h90" 
     140#    include "lbc_lnk_neicoll_generic.h90" 
     141# undef DIM_4d 
     142# undef MPI_TYPE 
     143#undef PRECISION 
    222144   !! 
    223145   !!   ----   DOUBLE PRECISION VERSIONS 
    224146   !! 
    225 #  define DIM_2d 
    226 #     define ROUTINE_LNK           mpp_lnk_2d_dp 
    227 #     include "mpp_lnk_generic.h90" 
    228 #     undef ROUTINE_LNK 
    229 #     define MULTI 
    230 #     define ROUTINE_LNK           mpp_lnk_2d_ptr_dp 
    231 #     include "mpp_lnk_generic.h90" 
    232 #     undef ROUTINE_LNK 
    233 #     undef MULTI 
    234 #  undef DIM_2d 
    235    ! 
    236    !                       !==  3D array and array of 3D pointer  ==! 
    237    ! 
    238 #  define DIM_3d 
    239 #     define ROUTINE_LNK           mpp_lnk_3d_dp 
    240 #     include "mpp_lnk_generic.h90" 
    241 #     undef ROUTINE_LNK 
    242 #     define MULTI 
    243 #     define ROUTINE_LNK           mpp_lnk_3d_ptr_dp 
    244 #     include "mpp_lnk_generic.h90" 
    245 #     undef ROUTINE_LNK 
    246 #     undef MULTI 
    247 #  undef DIM_3d 
    248    ! 
    249    !                       !==  4D array and array of 4D pointer  ==! 
    250    ! 
    251 #  define DIM_4d 
    252 #     define ROUTINE_LNK           mpp_lnk_4d_dp 
    253 #     include "mpp_lnk_generic.h90" 
    254 #     undef ROUTINE_LNK 
    255 #     define MULTI 
    256 #     define ROUTINE_LNK           mpp_lnk_4d_ptr_dp 
    257 #     include "mpp_lnk_generic.h90" 
    258 #     undef ROUTINE_LNK 
    259 #     undef MULTI 
    260 #  undef DIM_4d 
    261  
    262    !!---------------------------------------------------------------------- 
    263    !!                   ***   load_ptr_(2,3,4)d   *** 
    264    !! 
    265    !!   * Dummy Argument : 
    266    !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D) 
    267    !!                   cd_nat     ! nature of pt2d array grid-points 
    268    !!                   psgn       ! sign used across the north fold boundary 
    269    !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers 
    270    !!                   cdna_ptr   ! nature of ptab array grid-points 
    271    !!                   psgn_ptr   ! sign used across the north fold boundary 
    272    !!                   kfld       ! number of elements that has been attributed 
    273    !!---------------------------------------------------------------------- 
    274  
    275    !!---------------------------------------------------------------------- 
    276    !!                  ***   lbc_lnk_nc(2,3,4)d_multi   *** 
    277    !!                     ***   load_ptr_(2,3,4)d   *** 
    278    !! 
    279    !!   * Argument : dummy argument use in lbc_lnk_nc_multi_... routines 
    280    !! 
    281    !!---------------------------------------------------------------------- 
    282  
    283    !! 
    284    !!   ----   SINGLE PRECISION VERSIONS 
    285    !! 
    286 #  define SINGLE_PRECISION 
    287 #  define DIM_2d 
    288 #     define ROUTINE_NC_LOAD           load_ptr_nc_2d_sp 
    289 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_2d_sp 
    290 #     include "lbc_lnk_nc_generic.h90" 
    291 #     undef ROUTINE_MULTI_NC 
    292 #     undef ROUTINE_NC_LOAD 
    293 #  undef DIM_2d 
    294  
    295 #  define DIM_3d 
    296 #     define ROUTINE_NC_LOAD           load_ptr_nc_3d_sp 
    297 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_3d_sp 
    298 #     include "lbc_lnk_nc_generic.h90" 
    299 #     undef ROUTINE_MULTI_NC 
    300 #     undef ROUTINE_NC_LOAD 
    301 #  undef DIM_3d 
    302  
    303 #  define DIM_4d 
    304 #     define ROUTINE_NC_LOAD           load_ptr_nc_4d_sp 
    305 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_4d_sp 
    306 #     include "lbc_lnk_nc_generic.h90" 
    307 #     undef ROUTINE_MULTI_NC 
    308 #     undef ROUTINE_NC_LOAD 
    309 #  undef DIM_4d 
    310 #  undef SINGLE_PRECISION 
    311    !! 
    312    !!   ----   DOUBLE PRECISION VERSIONS 
    313    !! 
    314  
    315 #  define DIM_2d 
    316 #     define ROUTINE_NC_LOAD           load_ptr_nc_2d_dp 
    317 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_2d_dp 
    318 #     include "lbc_lnk_nc_generic.h90" 
    319 #     undef ROUTINE_MULTI_NC 
    320 #     undef ROUTINE_NC_LOAD 
    321 #  undef DIM_2d 
    322  
    323 #  define DIM_3d 
    324 #     define ROUTINE_NC_LOAD           load_ptr_nc_3d_dp 
    325 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_3d_dp 
    326 #     include "lbc_lnk_nc_generic.h90" 
    327 #     undef ROUTINE_MULTI_NC 
    328 #     undef ROUTINE_NC_LOAD 
    329 #  undef DIM_3d 
    330  
    331 #  define DIM_4d 
    332 #     define ROUTINE_NC_LOAD           load_ptr_nc_4d_dp 
    333 #     define ROUTINE_MULTI_NC          lbc_lnk_nc_4d_dp 
    334 #     include "lbc_lnk_nc_generic.h90" 
    335 #     undef ROUTINE_MULTI_NC 
    336 #     undef ROUTINE_NC_LOAD 
    337 #  undef DIM_4d 
    338  
    339    !!---------------------------------------------------------------------- 
    340    !!                   ***  routine mpp_lnk_nc_(2,3,4)d  *** 
    341    !! 
    342    !!   * Argument : dummy argument use in mpp_lnk_... routines 
    343    !!                ptab      :   array or pointer of arrays on which the boundary condition is applied 
    344    !!                cd_nat    :   nature of array grid-points 
    345    !!                psgn      :   sign used across the north fold boundary 
    346    !!                kfld      :   optional, number of pt3d arrays 
    347    !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables) 
    348    !!                pfillval  :   optional, background value (used with jpfillcopy) 
    349    !!---------------------------------------------------------------------- 
    350    ! 
    351    !                       !==  2D array and array of 2D pointer  ==! 
    352    ! 
    353    !! 
    354    !!   ----   SINGLE PRECISION VERSIONS 
    355    !! 
    356 # define SINGLE_PRECISION 
    357 #  define DIM_2d 
    358 #     define ROUTINE_NC           mpp_lnk_nc_2d_sp 
    359 #     include "mpp_nc_generic.h90" 
    360 #     undef ROUTINE_NC 
    361 #  undef DIM_2d 
    362    ! 
    363    !                       !==  3D array and array of 3D pointer  ==! 
    364    ! 
    365 #  define DIM_3d 
    366 #     define ROUTINE_NC           mpp_lnk_nc_3d_sp 
    367 #     include "mpp_nc_generic.h90" 
    368 #     undef ROUTINE_NC 
    369 #  undef DIM_3d 
    370    ! 
    371    !                       !==  4D array and array of 4D pointer  ==! 
    372    ! 
    373 #  define DIM_4d 
    374 #     define ROUTINE_NC           mpp_lnk_nc_4d_sp 
    375 #     include "mpp_nc_generic.h90" 
    376 #     undef ROUTINE_NC 
    377 #  undef DIM_4d 
    378 # undef SINGLE_PRECISION 
    379  
    380    !! 
    381    !!   ----   DOUBLE PRECISION VERSIONS 
    382    !! 
    383 #  define DIM_2d 
    384 #     define ROUTINE_NC           mpp_lnk_nc_2d_dp 
    385 #     include "mpp_nc_generic.h90" 
    386 #     undef ROUTINE_NC 
    387 #  undef DIM_2d 
    388    ! 
    389    !                       !==  3D array and array of 3D pointer  ==! 
    390    ! 
    391 #  define DIM_3d 
    392 #     define ROUTINE_NC           mpp_lnk_nc_3d_dp 
    393 #     include "mpp_nc_generic.h90" 
    394 #     undef ROUTINE_NC 
    395 #  undef DIM_3d 
    396    ! 
    397    !                       !==  4D array and array of 4D pointer  ==! 
    398    ! 
    399 #  define DIM_4d 
    400 #     define ROUTINE_NC           mpp_lnk_nc_4d_dp 
    401 #     include "mpp_nc_generic.h90" 
    402 #     undef ROUTINE_NC 
    403 #  undef DIM_4d 
    404  
    405    !!---------------------------------------------------------------------- 
    406    !!                   ***  routine mpp_nfd_(2,3,4)d  *** 
    407    !! 
    408    !!   * Argument : dummy argument use in mpp_nfd_... routines 
    409    !!                ptab      :   array or pointer of arrays on which the boundary condition is applied 
    410    !!                cd_nat    :   nature of array grid-points 
    411    !!                psgn      :   sign used across the north fold boundary 
    412    !!                kfld      :   optional, number of pt3d arrays 
    413    !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables) 
    414    !!                pfillval  :   optional, background value (used with jpfillcopy) 
    415    !!---------------------------------------------------------------------- 
    416    ! 
    417    !                       !==  2D array and array of 2D pointer  ==! 
    418    ! 
    419    !! 
    420    !!   ----   SINGLE PRECISION VERSIONS 
    421    !! 
    422 #  define SINGLE_PRECISION 
    423 #  define DIM_2d 
    424 #     define ROUTINE_NFD           mpp_nfd_2d_sp 
    425 #     include "mpp_nfd_generic.h90" 
    426 #     undef ROUTINE_NFD 
    427 #     define MULTI 
    428 #     define ROUTINE_NFD           mpp_nfd_2d_ptr_sp 
    429 #     include "mpp_nfd_generic.h90" 
    430 #     undef ROUTINE_NFD 
    431 #     undef MULTI 
    432 #  undef DIM_2d 
    433    ! 
    434    !                       !==  3D array and array of 3D pointer  ==! 
    435    ! 
    436 #  define DIM_3d 
    437 #     define ROUTINE_NFD           mpp_nfd_3d_sp 
    438 #     include "mpp_nfd_generic.h90" 
    439 #     undef ROUTINE_NFD 
    440 #     define MULTI 
    441 #     define ROUTINE_NFD           mpp_nfd_3d_ptr_sp 
    442 #     include "mpp_nfd_generic.h90" 
    443 #     undef ROUTINE_NFD 
    444 #     undef MULTI 
    445 #  undef DIM_3d 
    446    ! 
    447    !                       !==  4D array and array of 4D pointer  ==! 
    448    ! 
    449 #  define DIM_4d 
    450 #     define ROUTINE_NFD           mpp_nfd_4d_sp 
    451 #     include "mpp_nfd_generic.h90" 
    452 #     undef ROUTINE_NFD 
    453 #     define MULTI 
    454 #     define ROUTINE_NFD           mpp_nfd_4d_ptr_sp 
    455 #     include "mpp_nfd_generic.h90" 
    456 #     undef ROUTINE_NFD 
    457 #     undef MULTI 
    458 #  undef DIM_4d 
    459 #  undef SINGLE_PRECISION 
    460  
    461    !! 
    462    !!   ----   DOUBLE PRECISION VERSIONS 
    463    !! 
    464 #  define DIM_2d 
    465 #     define ROUTINE_NFD           mpp_nfd_2d_dp 
    466 #     include "mpp_nfd_generic.h90" 
    467 #     undef ROUTINE_NFD 
    468 #     define MULTI 
    469 #     define ROUTINE_NFD           mpp_nfd_2d_ptr_dp 
    470 #     include "mpp_nfd_generic.h90" 
    471 #     undef ROUTINE_NFD 
    472 #     undef MULTI 
    473 #  undef DIM_2d 
    474    ! 
    475    !                       !==  3D array and array of 3D pointer  ==! 
    476    ! 
    477 #  define DIM_3d 
    478 #     define ROUTINE_NFD           mpp_nfd_3d_dp 
    479 #     include "mpp_nfd_generic.h90" 
    480 #     undef ROUTINE_NFD 
    481 #     define MULTI 
    482 #     define ROUTINE_NFD           mpp_nfd_3d_ptr_dp 
    483 #     include "mpp_nfd_generic.h90" 
    484 #     undef ROUTINE_NFD 
    485 #     undef MULTI 
    486 #  undef DIM_3d 
    487    ! 
    488    !                       !==  4D array and array of 4D pointer  ==! 
    489    ! 
    490 #  define DIM_4d 
    491 #     define ROUTINE_NFD           mpp_nfd_4d_dp 
    492 #     include "mpp_nfd_generic.h90" 
    493 #     undef ROUTINE_NFD 
    494 #     define MULTI 
    495 #     define ROUTINE_NFD           mpp_nfd_4d_ptr_dp 
    496 #     include "mpp_nfd_generic.h90" 
    497 #     undef ROUTINE_NFD 
    498 #     undef MULTI 
    499 #  undef DIM_4d 
    500  
    501    !!====================================================================== 
    502  
     147#define PRECISION dp 
     148# define MPI_TYPE MPI_DOUBLE_PRECISION 
     149# define DIM_2d 
     150#    include "lbc_lnk_pt2pt_generic.h90" 
     151#    include "lbc_lnk_neicoll_generic.h90" 
     152# undef DIM_2d 
     153# define DIM_3d 
     154#    include "lbc_lnk_pt2pt_generic.h90" 
     155#    include "lbc_lnk_neicoll_generic.h90" 
     156# undef DIM_3d 
     157# define DIM_4d 
     158#    include "lbc_lnk_pt2pt_generic.h90" 
     159#    include "lbc_lnk_neicoll_generic.h90" 
     160# undef DIM_4d 
     161# undef MPI_TYPE 
     162#undef PRECISION 
    503163 
    504164   !!====================================================================== 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbcnfd.F90

    r13286 r14338  
    2121   USE in_out_manager ! I/O manager 
    2222   USE lib_mpp        ! MPP library 
     23#if ! defined key_mpi_off 
     24   USE MPI 
     25#endif 
    2326 
    2427   IMPLICIT NONE 
    2528   PRIVATE 
    2629 
    27    INTERFACE lbc_nfd 
    28       MODULE PROCEDURE   lbc_nfd_2d_sp    , lbc_nfd_3d_sp    , lbc_nfd_4d_sp 
    29       MODULE PROCEDURE   lbc_nfd_2d_ptr_sp, lbc_nfd_3d_ptr_sp, lbc_nfd_4d_ptr_sp 
    30       MODULE PROCEDURE   lbc_nfd_2d_ext_sp 
    31       MODULE PROCEDURE   lbc_nfd_2d_dp    , lbc_nfd_3d_dp    , lbc_nfd_4d_dp 
    32       MODULE PROCEDURE   lbc_nfd_2d_ptr_dp, lbc_nfd_3d_ptr_dp, lbc_nfd_4d_ptr_dp 
    33       MODULE PROCEDURE   lbc_nfd_2d_ext_dp 
    34    END INTERFACE 
    35    ! 
    36    INTERFACE lbc_nfd_nogather 
    37 !                        ! Currently only 4d array version is needed 
    38      MODULE PROCEDURE   lbc_nfd_nogather_2d_sp    , lbc_nfd_nogather_3d_sp 
    39      MODULE PROCEDURE   lbc_nfd_nogather_4d_sp 
    40      MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr_sp, lbc_nfd_nogather_3d_ptr_sp 
    41      MODULE PROCEDURE   lbc_nfd_nogather_2d_dp    , lbc_nfd_nogather_3d_dp 
    42      MODULE PROCEDURE   lbc_nfd_nogather_4d_dp 
    43      MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr_dp, lbc_nfd_nogather_3d_ptr_dp 
    44 !     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr 
     30   INTERFACE lbc_nfd   ! called by mpp_nfd, lbc_lnk_pt2pt, lbc_lnk_neicoll 
     31      MODULE PROCEDURE   lbc_nfd_2d_sp, lbc_nfd_ext_2d_sp, lbc_nfd_3d_sp, lbc_nfd_4d_sp 
     32      MODULE PROCEDURE   lbc_nfd_2d_dp, lbc_nfd_ext_2d_dp, lbc_nfd_3d_dp, lbc_nfd_4d_dp 
    4533   END INTERFACE 
    4634 
    47    TYPE, PUBLIC ::   PTR_2D_dp   !: array of 2D pointers (also used in lib_mpp) 
    48       REAL(dp), DIMENSION (:,:)    , POINTER ::   pt2d 
    49    END TYPE PTR_2D_dp 
    50    TYPE, PUBLIC ::   PTR_3D_dp   !: array of 3D pointers (also used in lib_mpp) 
    51       REAL(dp), DIMENSION (:,:,:)  , POINTER ::   pt3d 
    52    END TYPE PTR_3D_dp 
    53    TYPE, PUBLIC ::   PTR_4D_dp   !: array of 4D pointers (also used in lib_mpp) 
    54       REAL(dp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
    55    END TYPE PTR_4D_dp 
     35   INTERFACE lbc_nfd_nogather   ! called by mpp_nfd 
     36      MODULE PROCEDURE   lbc_nfd_nogather_2d_sp, lbc_nfd_nogather_3d_sp, lbc_nfd_nogather_4d_sp 
     37      MODULE PROCEDURE   lbc_nfd_nogather_2d_dp, lbc_nfd_nogather_3d_dp, lbc_nfd_nogather_4d_dp 
     38   END INTERFACE 
    5639 
    57    TYPE, PUBLIC ::   PTR_2D_sp   !: array of 2D pointers (also used in lib_mpp) 
    58       REAL(sp), DIMENSION (:,:)    , POINTER ::   pt2d 
    59    END TYPE PTR_2D_sp 
    60    TYPE, PUBLIC ::   PTR_3D_sp   !: array of 3D pointers (also used in lib_mpp) 
    61       REAL(sp), DIMENSION (:,:,:)  , POINTER ::   pt3d 
    62    END TYPE PTR_3D_sp 
    63    TYPE, PUBLIC ::   PTR_4D_sp   !: array of 4D pointers (also used in lib_mpp) 
    64       REAL(sp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
    65    END TYPE PTR_4D_sp 
    66  
    67  
     40   INTERFACE mpp_nfd 
     41      MODULE PROCEDURE   mpp_nfd_2d_sp, mpp_nfd_3d_sp, mpp_nfd_4d_sp 
     42      MODULE PROCEDURE   mpp_nfd_2d_dp, mpp_nfd_3d_dp, mpp_nfd_4d_dp 
     43   END INTERFACE 
     44    
     45   PUBLIC   mpp_nfd            ! mpi north fold conditions 
    6846   PUBLIC   lbc_nfd            ! north fold conditions 
    6947   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case) 
    … …  
    8260 
    8361   !!---------------------------------------------------------------------- 
    84    !!                   ***  routine lbc_nfd_(2,3,4)d  *** 
     62   !!                   ***  routine lbc_nfd_[234]d_[sd]p  *** 
     63   !!               ***  routine lbc_nfd_nogather_[234]d_[sd]p  *** 
     64   !!                   ***  routine lbc_nfd_ext_2d_[sd]p  *** 
    8565   !!---------------------------------------------------------------------- 
    8666   !! 
    … …  
    9575   !                       !==  SINGLE PRECISION VERSIONS 
    9676   ! 
    97    ! 
    98    !                       !==  2D array and array of 2D pointer  ==! 
    99    ! 
    100 #  define SINGLE_PRECISION 
    101 #  define DIM_2d 
    102 #     define ROUTINE_NFD           lbc_nfd_2d_sp 
    103 #     include "lbc_nfd_generic.h90" 
    104 #     undef ROUTINE_NFD 
    105 #     define MULTI 
    106 #     define ROUTINE_NFD           lbc_nfd_2d_ptr_sp 
    107 #     include "lbc_nfd_generic.h90" 
    108 #     undef ROUTINE_NFD 
    109 #     undef MULTI 
    110 #  undef DIM_2d 
    111    ! 
    112    !                       !==  2D array with extra haloes  ==! 
    113    ! 
    114 #  define DIM_2d 
    115 #     define ROUTINE_NFD           lbc_nfd_2d_ext_sp 
    116 #     include "lbc_nfd_ext_generic.h90" 
    117 #     undef ROUTINE_NFD 
    118 #  undef DIM_2d 
    119    ! 
    120    !                       !==  3D array and array of 3D pointer  ==! 
    121    ! 
    122 #  define DIM_3d 
    123 #     define ROUTINE_NFD           lbc_nfd_3d_sp 
    124 #     include "lbc_nfd_generic.h90" 
    125 #     undef ROUTINE_NFD 
    126 #     define MULTI 
    127 #     define ROUTINE_NFD           lbc_nfd_3d_ptr_sp 
    128 #     include "lbc_nfd_generic.h90" 
    129 #     undef ROUTINE_NFD 
    130 #     undef MULTI 
    131 #  undef DIM_3d 
    132    ! 
    133    !                       !==  4D array and array of 4D pointer  ==! 
    134    ! 
    135 #  define DIM_4d 
    136 #     define ROUTINE_NFD           lbc_nfd_4d_sp 
    137 #     include "lbc_nfd_generic.h90" 
    138 #     undef ROUTINE_NFD 
    139 #     define MULTI 
    140 #     define ROUTINE_NFD           lbc_nfd_4d_ptr_sp 
    141 #     include "lbc_nfd_generic.h90" 
    142 #     undef ROUTINE_NFD 
    143 #     undef MULTI 
    144 #  undef DIM_4d 
    145    ! 
    146    !  lbc_nfd_nogather routines 
    147    ! 
    148    !                       !==  2D array and array of 2D pointer  ==! 
    149    ! 
    150 #  define DIM_2d 
    151 #     define ROUTINE_NFD           lbc_nfd_nogather_2d_sp 
    152 #     include "lbc_nfd_nogather_generic.h90" 
    153 #     undef ROUTINE_NFD 
    154 #     define MULTI 
    155 #     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr_sp 
    156 #     include "lbc_nfd_nogather_generic.h90" 
    157 #     undef ROUTINE_NFD 
    158 #     undef MULTI 
    159 #  undef DIM_2d 
    160    ! 
    161    !                       !==  3D array and array of 3D pointer  ==! 
    162    ! 
    163 #  define DIM_3d 
    164 #     define ROUTINE_NFD           lbc_nfd_nogather_3d_sp 
    165 #     include "lbc_nfd_nogather_generic.h90" 
    166 #     undef ROUTINE_NFD 
    167 #     define MULTI 
    168 #     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr_sp 
    169 #     include "lbc_nfd_nogather_generic.h90" 
    170 #     undef ROUTINE_NFD 
    171 #     undef MULTI 
    172 #  undef DIM_3d 
    173    ! 
    174    !                       !==  4D array and array of 4D pointer  ==! 
    175    ! 
    176 #  define DIM_4d 
    177 #     define ROUTINE_NFD           lbc_nfd_nogather_4d_sp 
    178 #     include "lbc_nfd_nogather_generic.h90" 
    179 #     undef ROUTINE_NFD 
    180 !#     define MULTI 
    181 !#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr 
    182 !#     include "lbc_nfd_nogather_generic.h90" 
    183 !#     undef ROUTINE_NFD 
    184 !#     undef MULTI 
    185 #  undef DIM_4d 
    186 #  undef SINGLE_PRECISION 
    187  
    188    !!---------------------------------------------------------------------- 
     77#define PRECISION sp 
     78# define DIM_2d 
     79#    include "lbc_nfd_generic.h90" 
     80#    include "lbc_nfd_nogather_generic.h90" 
     81#    include "lbc_nfd_ext_generic.h90" 
     82# undef DIM_2d 
     83# define DIM_3d 
     84#    include "lbc_nfd_generic.h90" 
     85#    include "lbc_nfd_nogather_generic.h90" 
     86# undef DIM_3d 
     87# define DIM_4d 
     88#    include "lbc_nfd_generic.h90" 
     89#    include "lbc_nfd_nogather_generic.h90" 
     90# undef DIM_4d 
     91#undef PRECISION 
    18992   ! 
    19093   !                       !==  DOUBLE PRECISION VERSIONS 
    19194   ! 
     95#define PRECISION dp 
     96# define DIM_2d 
     97#    include "lbc_nfd_generic.h90" 
     98#    include "lbc_nfd_nogather_generic.h90" 
     99#    include "lbc_nfd_ext_generic.h90" 
     100# undef DIM_2d 
     101# define DIM_3d 
     102#    include "lbc_nfd_generic.h90" 
     103#    include "lbc_nfd_nogather_generic.h90" 
     104# undef DIM_3d 
     105# define DIM_4d 
     106#    include "lbc_nfd_generic.h90" 
     107#    include "lbc_nfd_nogather_generic.h90" 
     108# undef DIM_4d 
     109#undef PRECISION 
     110 
     111   !!====================================================================== 
    192112   ! 
    193    !                       !==  2D array and array of 2D pointer  ==! 
    194    ! 
    195 #  define DIM_2d 
    196 #     define ROUTINE_NFD           lbc_nfd_2d_dp 
    197 #     include "lbc_nfd_generic.h90" 
    198 #     undef ROUTINE_NFD 
    199 #     define MULTI 
    200 #     define ROUTINE_NFD           lbc_nfd_2d_ptr_dp 
    201 #     include "lbc_nfd_generic.h90" 
    202 #     undef ROUTINE_NFD 
    203 #     undef MULTI 
    204 #  undef DIM_2d 
    205    ! 
    206    !                       !==  2D array with extra haloes  ==! 
    207    ! 
    208 #  define DIM_2d 
    209 #     define ROUTINE_NFD           lbc_nfd_2d_ext_dp 
    210 #     include "lbc_nfd_ext_generic.h90" 
    211 #     undef ROUTINE_NFD 
    212 #  undef DIM_2d 
    213    ! 
    214    !                       !==  3D array and array of 3D pointer  ==! 
    215    ! 
    216 #  define DIM_3d 
    217 #     define ROUTINE_NFD           lbc_nfd_3d_dp 
    218 #     include "lbc_nfd_generic.h90" 
    219 #     undef ROUTINE_NFD 
    220 #     define MULTI 
    221 #     define ROUTINE_NFD           lbc_nfd_3d_ptr_dp 
    222 #     include "lbc_nfd_generic.h90" 
    223 #     undef ROUTINE_NFD 
    224 #     undef MULTI 
    225 #  undef DIM_3d 
    226    ! 
    227    !                       !==  4D array and array of 4D pointer  ==! 
    228    ! 
    229 #  define DIM_4d 
    230 #     define ROUTINE_NFD           lbc_nfd_4d_dp 
    231 #     include "lbc_nfd_generic.h90" 
    232 #     undef ROUTINE_NFD 
    233 #     define MULTI 
    234 #     define ROUTINE_NFD           lbc_nfd_4d_ptr_dp 
    235 #     include "lbc_nfd_generic.h90" 
    236 #     undef ROUTINE_NFD 
    237 #     undef MULTI 
    238 #  undef DIM_4d 
    239    ! 
    240    !  lbc_nfd_nogather routines 
    241    ! 
    242    !                       !==  2D array and array of 2D pointer  ==! 
    243    ! 
    244 #  define DIM_2d 
    245 #     define ROUTINE_NFD           lbc_nfd_nogather_2d_dp 
    246 #     include "lbc_nfd_nogather_generic.h90" 
    247 #     undef ROUTINE_NFD 
    248 #     define MULTI 
    249 #     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr_dp 
    250 #     include "lbc_nfd_nogather_generic.h90" 
    251 #     undef ROUTINE_NFD 
    252 #     undef MULTI 
    253 #  undef DIM_2d 
    254    ! 
    255    !                       !==  3D array and array of 3D pointer  ==! 
    256    ! 
    257 #  define DIM_3d 
    258 #     define ROUTINE_NFD           lbc_nfd_nogather_3d_dp 
    259 #     include "lbc_nfd_nogather_generic.h90" 
    260 #     undef ROUTINE_NFD 
    261 #     define MULTI 
    262 #     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr_dp 
    263 #     include "lbc_nfd_nogather_generic.h90" 
    264 #     undef ROUTINE_NFD 
    265 #     undef MULTI 
    266 #  undef DIM_3d 
    267    ! 
    268    !                       !==  4D array and array of 4D pointer  ==! 
    269    ! 
    270 #  define DIM_4d 
    271 #     define ROUTINE_NFD           lbc_nfd_nogather_4d_dp 
    272 #     include "lbc_nfd_nogather_generic.h90" 
    273 #     undef ROUTINE_NFD 
    274 !#     define MULTI 
    275 !#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr 
    276 !#     include "lbc_nfd_nogather_generic.h90" 
    277 !#     undef ROUTINE_NFD 
    278 !#     undef MULTI 
    279 #  undef DIM_4d 
    280  
    281113   !!---------------------------------------------------------------------- 
    282  
    283  
     114   !!                   ***  routine mpp_nfd_(2,3,4)d  *** 
     115   !! 
     116   !!   * Argument : dummy argument use in mpp_nfd_... routines 
     117   !!                ptab      :   pointer of arrays on which the boundary condition is applied 
     118   !!                cd_nat    :   nature of array grid-points 
     119   !!                psgn      :   sign used across the north fold boundary 
     120   !!                kfld      :   optional, number of pt3d arrays 
     121   !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables) 
     122   !!                pfillval  :   optional, background value (used with jpfillcopy) 
     123   !!---------------------------------------------------------------------- 
     124   !! 
     125   !!   ----   SINGLE PRECISION VERSIONS 
     126   !! 
     127#define PRECISION sp 
     128# define MPI_TYPE MPI_REAL 
     129# define DIM_2d 
     130#    include "mpp_nfd_generic.h90" 
     131# undef DIM_2d 
     132# define DIM_3d 
     133#    include "mpp_nfd_generic.h90" 
     134# undef DIM_3d 
     135# define DIM_4d 
     136#    include "mpp_nfd_generic.h90" 
     137# undef DIM_4d 
     138# undef MPI_TYPE 
     139#undef PRECISION 
     140   !! 
     141   !!   ----   DOUBLE PRECISION VERSIONS 
     142   !! 
     143#define PRECISION dp 
     144# define MPI_TYPE MPI_DOUBLE_PRECISION 
     145# define DIM_2d 
     146#    include "mpp_nfd_generic.h90" 
     147# undef DIM_2d 
     148# define DIM_3d 
     149#    include "mpp_nfd_generic.h90" 
     150# undef DIM_3d 
     151# define DIM_4d 
     152#    include "mpp_nfd_generic.h90" 
     153# undef DIM_4d 
     154# undef MPI_TYPE 
     155#undef PRECISION 
    284156 
    285157   !!====================================================================== 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lib_mpp.F90

    r14314 r14338  
    5555   USE dom_oce        ! ocean space and time domain 
    5656   USE in_out_manager ! I/O manager 
     57#if ! defined key_mpi_off 
     58   USE MPI 
     59#endif 
    5760 
    5861   IMPLICIT NONE 
    … …  
    107110   END INTERFACE 
    108111 
     112   TYPE, PUBLIC ::   PTR_2D_sp   !: array of 2D pointers (used in lbclnk and lbcnfd) 
     113      REAL(sp), DIMENSION (:,:)    , POINTER ::   pt2d 
     114   END TYPE PTR_2D_sp 
     115   TYPE, PUBLIC ::   PTR_3D_sp   !: array of 3D pointers (used in lbclnk and lbcnfd) 
     116      REAL(sp), DIMENSION (:,:,:)  , POINTER ::   pt3d 
     117   END TYPE PTR_3D_sp 
     118   TYPE, PUBLIC ::   PTR_4D_sp   !: array of 4D pointers (used in lbclnk and lbcnfd) 
     119      REAL(sp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
     120   END TYPE PTR_4D_sp 
     121 
     122   TYPE, PUBLIC ::   PTR_2D_dp   !: array of 2D pointers (used in lbclnk and lbcnfd) 
     123      REAL(dp), DIMENSION (:,:)    , POINTER ::   pt2d 
     124   END TYPE PTR_2D_dp 
     125   TYPE, PUBLIC ::   PTR_3D_dp   !: array of 3D pointers (used in lbclnk and lbcnfd) 
     126      REAL(dp), DIMENSION (:,:,:)  , POINTER ::   pt3d 
     127   END TYPE PTR_3D_dp 
     128   TYPE, PUBLIC ::   PTR_4D_dp   !: array of 4D pointers (used in lbclnk and lbcnfd) 
     129      REAL(dp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
     130   END TYPE PTR_4D_dp 
     131 
    109132   !! ========================= !! 
    110133   !!  MPI  variable definition !! 
    111134   !! ========================= !! 
    112135#if ! defined key_mpi_off 
    113 !$AGRIF_DO_NOT_TREAT 
    114    INCLUDE 'mpif.h' 
    115 !$AGRIF_END_DO_NOT_TREAT 
    116136   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    117137#else 
    … …  
    199219 
    200220   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
     221   INTEGER, PUBLIC ::   nn_comm                     !: namelist control of comms 
     222 
     223   INTEGER, PUBLIC, PARAMETER ::   jpfillnothing = 1 
     224   INTEGER, PUBLIC, PARAMETER ::   jpfillcst     = 2 
     225   INTEGER, PUBLIC, PARAMETER ::   jpfillcopy    = 3 
     226   INTEGER, PUBLIC, PARAMETER ::   jpfillperio   = 4 
     227   INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5 
    201228 
    202229   !! * Substitutions 
    … …  
    276303      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    277304      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    278       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     305      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    279306      !! 
    280307      INTEGER ::   iflag 
    … …  
    305332      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    306333      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    307       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     334      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    308335      !! 
    309336      INTEGER ::   iflag 
    … …  
    328355      INTEGER , INTENT(in   ) ::   kdest      ! receive process number 
    329356      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message 
    330       INTEGER , INTENT(in   ) ::   md_req     ! argument for isend 
     357      INTEGER , INTENT(inout) ::   md_req     ! argument for isend 
    331358      !! 
    332359      INTEGER ::   iflag 
    … …  
    955982      LOGICAL, OPTIONAL, INTENT(in) :: ld_abort    ! source process number 
    956983      LOGICAL ::   ll_abort 
    957       INTEGER ::   info 
     984      INTEGER ::   info, ierr 
    958985      !!---------------------------------------------------------------------- 
    959986      ll_abort = .FALSE. 
    … …  
    962989#if ! defined key_mpi_off 
    963990      IF(ll_abort) THEN 
    964          CALL mpi_abort( MPI_COMM_WORLD ) 
     991         CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 
    965992      ELSE 
    966993         CALL mppsync 
    … …  
    9751002   SUBROUTINE mpp_comm_free( kcom ) 
    9761003      !!---------------------------------------------------------------------- 
    977       INTEGER, INTENT(in) ::   kcom 
     1004      INTEGER, INTENT(inout) ::   kcom 
    9781005      !! 
    9791006      INTEGER :: ierr 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_nfd_generic.h90

    r14336 r14338  
    1 #if defined MULTI 
    2 #   define NAT_IN(k)                cd_nat(k)    
    3 #   define SGN_IN(k)                psgn(k) 
    4 #   define F_SIZE(ptab)             kfld 
    5 #   define LBC_ARG                  (jf) 
    6 #   if defined DIM_2d 
    7 #      if defined SINGLE_PRECISION 
    8 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)     , INTENT(inout) ::   ptab(f) 
    9 #      else 
    10 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)     , INTENT(inout) ::   ptab(f) 
    11 #      endif 
    12 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
    13 #      define K_SIZE(ptab)             1 
    14 #      define L_SIZE(ptab)             1 
    15 #   endif 
    16 #   if defined DIM_3d 
    17 #      if defined SINGLE_PRECISION 
    18 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)     , INTENT(inout) ::   ptab(f) 
    19 #      else 
    20 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)     , INTENT(inout) ::   ptab(f) 
    21 #      endif 
    22 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
    23 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    24 #      define L_SIZE(ptab)             1 
    25 #   endif 
    26 #   if defined DIM_4d 
    27 #      if defined SINGLE_PRECISION 
    28 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)     , INTENT(inout) ::   ptab(f) 
    29 #      else 
    30 #         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)     , INTENT(inout) ::   ptab(f) 
    31 #      endif 
    32 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
    33 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    34 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    35 #   endif 
    36 #else 
    37 !                          !==  IN: ptab is an array  ==! 
    38 #   if defined SINGLE_PRECISION 
    39 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
    40 #   else 
    41 #      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f) 
    42 #   endif 
    43 #   define NAT_IN(k)                cd_nat 
    44 #   define SGN_IN(k)                psgn 
    45 #   define F_SIZE(ptab)             1 
    46 #   define LBC_ARG 
    47 #   if defined DIM_2d 
    48 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
    49 #      define K_SIZE(ptab)          1 
    50 #      define L_SIZE(ptab)          1 
    51 #   endif 
    52 #   if defined DIM_3d 
    53 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k) 
    54 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    55 #      define L_SIZE(ptab)          1 
    56 #   endif 
    57 #   if defined DIM_4d 
    58 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l) 
    59 #      define K_SIZE(ptab)          SIZE(ptab,3) 
    60 #      define L_SIZE(ptab)          SIZE(ptab,4) 
    61 #   endif 
    62 #endif 
     1#if defined DIM_2d 
     2#   define XD                       2d 
     3#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
     4#   define ARRAY_LOCAL(i,j,k,l,f)   zptr(f)%pt4d(i,j,1:1,1:1) 
     5#   define K_SIZE(ptab)             1 
     6#   define L_SIZE(ptab)             1 
     7#endif 
     8#if defined DIM_3d 
     9#   define XD                       3d 
     10#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
     11#   define ARRAY_LOCAL(i,j,k,l,f)   zptr(f)%pt4d(i,j,k,1:1) 
     12#   define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
     13#   define L_SIZE(ptab)             1 
     14#endif 
     15#if defined DIM_4d 
     16#   define XD                       4d 
     17#   define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
     18#   define ARRAY_LOCAL(i,j,k,l,f)   zptr(f)%pt4d(i,j,k,l) 
     19#   define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
     20#   define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
     21#endif 
     22#define    F_SIZE(ptab)             kfld 
    6323 
    64 # if defined SINGLE_PRECISION 
    65 #    define PRECISION sp 
    66 #    define SENDROUTINE mppsend_sp 
    67 #    define RECVROUTINE mpprecv_sp 
    68 #    define MPI_TYPE MPI_REAL 
    69 #    define HUGEVAL(x)   HUGE(x/**/_sp) 
    70 # else 
    71 #    define PRECISION dp 
    72 #    define SENDROUTINE mppsend_dp 
    73 #    define RECVROUTINE mpprecv_dp 
    74 #    define MPI_TYPE MPI_DOUBLE_PRECISION 
    75 #    define HUGEVAL(x)   HUGE(x/**/_dp) 
    76 # endif 
    77  
    78    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, kfld ) 
    79       !!---------------------------------------------------------------------- 
    80       ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
    81       CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    82       REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    83       INTEGER          , INTENT(in   ) ::   kfillmode   ! filling method for halo over land  
    84       REAL(PRECISION)  , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    85       INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays 
     24   SUBROUTINE mpp_nfd_/**/XD/**/_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, kfld ) 
     25      TYPE(PTR_/**/XD/**/_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c. 
     26      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     27      REAL(PRECISION),  DIMENSION(:), INTENT(in   ) ::   psgn        ! sign used across the north fold boundary 
     28      INTEGER                       , INTENT(in   ) ::   kfillmode   ! filling method for halo over land  
     29      REAL(PRECISION)               , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     30      INTEGER                       , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    8631      ! 
    8732      LOGICAL  ::   ll_add_line 
    … …  
    9540      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather 
    9641      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather 
    97       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather 
    9842      !                                                    ! Workspace for message transfers avoiding mpi_allgather 
    9943      INTEGER                             ::   ipj_b       ! sum of lines for all multi fields 
    … …  
    10347      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines 
    10448      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays 
    105       REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztabglo, znorthloc 
     49      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc 
    10650      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo 
     51      TYPE(PTR_4D_/**/PRECISION), DIMENSION(:), ALLOCATABLE ::   ztabglo        ! array or pointer of arrays on which apply the b.c. 
    10752      !!---------------------------------------------------------------------- 
    10853      ! 
    … …  
    14186         IF( ll_add_line ) THEN 
    14287            DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
    143                ipj_s(jf) = nn_hls + COUNT( (/ c_NFtype == 'T' .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) )  
     88               ipj_s(jf) = nn_hls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )  
    14489            END DO 
    14590         ELSE 
    … …  
    156101            ! 
    157102            IF( c_NFtype == 'T' ) THEN          ! *  North fold  T-point pivot 
    158                SELECT CASE ( NAT_IN(jf) ) 
     103               SELECT CASE ( cd_nat(jf) ) 
    159104               CASE ( 'T', 'W', 'U' )   ;   i012 = 1   ! T-, U-, W-point 
    160105               CASE ( 'V', 'F'      )   ;   i012 = 2   ! V-, F-point 
    … …  
    162107            ENDIF 
    163108            IF( c_NFtype == 'F' ) THEN          ! *  North fold  F-point pivot 
    164                SELECT CASE ( NAT_IN(jf) ) 
     109               SELECT CASE ( cd_nat(jf) ) 
    165110               CASE ( 'T', 'W', 'U' )   ;   i012 = 0   ! T-, U-, W-point 
    166111               CASE ( 'V', 'F'      )   ;   i012 = 1   ! V-, F-point 
    … …  
    187132               END DO 
    188133               DO ji = jpi+1, jpimax 
    189                   ztabb(ji,ij1,jk,jl) = HUGEVAL(0.)   ! avoid sending uninitialized values (make sure we don't use it) 
     134                  ztabb(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION)   ! avoid sending uninitialized values (make sure we don't use it) 
    190135               END DO 
    191136            END DO 
    … …  
    199144            iproc = nfproc(isendto(jr)) 
    200145            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 
    201                CALL SENDROUTINE( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) ) 
     146#if ! defined key_mpi_off 
     147               CALL MPI_ISEND( ztabb, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ml_req_nf(jr), ierr ) 
     148#endif 
    202149            ENDIF 
    203150         END DO 
    … …  
    258205            ELSE                               ! get data from a neighbour trough communication 
    259206               !   
    260                CALL RECVROUTINE(5, ztabw, ibuffsize, iproc) 
     207#if ! defined key_mpi_off 
     208               CALL MPI_RECV( ztabw, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, MPI_STATUS_IGNORE, ierr ) 
     209#endif 
    261210               DO jl = 1, ipl   ;   DO jk = 1, ipk 
    262211                  DO jj = 1, ipj_b 
    … …  
    278227            ij1 = jj_b(       1 ,jf) 
    279228            ij2 = jj_b(ipj_s(jf),jf) 
    280             CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat LBC_ARG, psgn LBC_ARG ) 
     229            CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat(jf), psgn(jf) ) 
    281230         END DO 
    282231         ! 
    … …  
    286235            iproc = nfproc(isendto(jr)) 
    287236            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 
    288                CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )   ! put the wait at the very end just before the deallocate 
     237               CALL mpi_wait( ml_req_nf(jr), MPI_STATUS_IGNORE, ml_err )   ! put the wait at the very end just before the deallocate 
    289238            ENDIF 
    290239         END DO 
    … …  
    310259               END DO 
    311260               DO ji = Ni_0+1, i0max 
    312                   znorthloc(ji,jj,jk,jl,jf) = HUGEVAL(0.)   ! avoid sending uninitialized values (make sure we don't use it) 
     261                  znorthloc(ji,jj,jk,jl,jf) = HUGE(0._/**/PRECISION)   ! avoid sending uninitialized values (make sure we don't use it) 
    313262               END DO 
    314263            END DO 
    … …  
    323272         IF( ln_timing ) CALL tic_tac(.FALSE.) 
    324273         DEALLOCATE( znorthloc ) 
    325          ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) ) 
     274         ALLOCATE( ztabglo(ipf) ) 
     275         DO jf = 1, ipf 
     276            ALLOCATE( ztabglo(jf)%pt4d(jpiglo,ipj2,ipk,ipl) ) 
     277         END DO 
    326278         ! 
    327279         ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines 
    … …  
    341293                        DO ji = 1, ipi 
    342294                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
    343                            ztabglo(ii1,jj,jk,jl,jf) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
     295                           ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
    344296                        END DO 
    345297                     END DO 
    … …  
    350302                        DO ji = 1, ipi 
    351303                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
    352                            ztabglo(ii1,jj,jk,jl,jf) = pfillval 
     304                           ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval 
    353305                        END DO 
    354306                     END DO 
    … …  
    362314                     DO ji = 1, ipi 
    363315                        ii1 = impp + nn_hls + ji - 1             ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
    364                         ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,ijnr) 
     316                        ztabglo(jf)%pt4d(ii1,jj,jk,jl) = znorthglo(ji,jj,jk,jl,jf,ijnr) 
    365317                     END DO 
    366318                  END DO 
    … …  
    372324         ! 
    373325         DO jf = 1, ipf 
    374             CALL lbc_nfd( ztabglo(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
     326            CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), 1 )   ! North fold boundary condition 
    375327            DO jl = 1, ipl   ;   DO jk = 1, ipk                  ! e-w periodicity 
    376328               DO jj = 1, nn_hls + 1 
    377329                  ij1 = ipj2 - (nn_hls + 1) + jj                 ! need only the last nn_hls + 1 lines until ipj2 
    378                   ztabglo(              1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf) 
    379                   ztabglo(jpiglo-nn_hls+1:jpiglo,ij1,jk,jl,jf) = ztabglo(         nn_hls+1:     2*nn_hls,ij1,jk,jl,jf) 
     330                  ztabglo(jf)%pt4d(              1:nn_hls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl) 
     331                  ztabglo(jf)%pt4d(jpiglo-nn_hls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d(         nn_hls+1:     2*nn_hls,ij1,jk,jl) 
    380332               END DO 
    381333            END DO   ;   END DO 
    … …  
    388340               DO ji= 1, jpi 
    389341                  ii2 = mig(ji) 
    390                   ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(ii2,ij2,jk,jl,jf) 
     342                  ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(jf)%pt4d(ii2,ij2,jk,jl) 
    391343               END DO 
    392344            END DO 
    393345         END DO   ;   END DO   ;   END DO 
    394346         ! 
     347         DO jf = 1, ipf 
     348            DEALLOCATE( ztabglo(jf)%pt4d ) 
     349         END DO 
    395350         DEALLOCATE( ztabglo ) 
    396351         ! 
    397352      ENDIF   ! l_north_nogather 
    398353      ! 
    399    END SUBROUTINE ROUTINE_NFD 
     354   END SUBROUTINE mpp_nfd_/**/XD/**/_/**/PRECISION 
    400355 
    401 #undef PRECISION 
    402 #undef MPI_TYPE 
    403 #undef SENDROUTINE 
    404 #undef RECVROUTINE 
    405 #undef ARRAY_TYPE 
    406 #undef NAT_IN 
    407 #undef SGN_IN 
     356#undef XD 
    408357#undef ARRAY_IN 
     358#undef ARRAY_LOCAL 
    409359#undef K_SIZE 
    410360#undef L_SIZE 
    411361#undef F_SIZE 
    412 #undef LBC_ARG 
    413 #undef HUGEVAL 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mppini.F90

    r14336 r14338  
    145145           &             cn_ice, nn_ice_dta,                                     & 
    146146           &             ln_vol, nn_volctl, nn_rimwidth 
    147       NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 
     147      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm 
    148148      !!---------------------------------------------------------------------- 
    149149      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfc1d_c2d.F90

    r14189 r14338  
    9595         END_3D 
    9696         ! Lateral boundary conditions 
    97          CALL lbc_lnk_multi( 'ldfc1d_c2d', pah1, 'U', 1.0_wp , pah2, 'V', 1.0_wp ) 
     97         CALL lbc_lnk( 'ldfc1d_c2d', pah1, 'U', 1.0_wp , pah2, 'V', 1.0_wp ) 
    9898         ! 
    9999      CASE DEFAULT                        ! error 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfdyn.F90

    r14201 r14338  
    412412         ENDIF 
    413413         ! 
    414          CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.0_wp,  ahmf, 'F', 1.0_wp ) 
     414         CALL lbc_lnk( 'ldfdyn', ahmt, 'T', 1.0_wp,  ahmf, 'F', 1.0_wp ) 
    415415         ! 
    416416         ! 
    … …  
    444444            END DO 
    445445            ! 
    446             CALL lbc_lnk_multi( 'ldfdyn', dtensq, 'T', 1.0_wp )  ! lbc_lnk on dshesq not needed 
     446            CALL lbc_lnk( 'ldfdyn', dtensq, 'T', 1.0_wp )  ! lbc_lnk on dshesq not needed 
    447447            ! 
    448448            DO jk = 1, jpkm1 
    … …  
    495495         ENDIF 
    496496         ! 
    497          CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.0_wp , ahmf, 'F', 1.0_wp ) 
     497         CALL lbc_lnk( 'ldfdyn', ahmt, 'T', 1.0_wp , ahmf, 'F', 1.0_wp ) 
    498498         ! 
    499499      END SELECT 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfslp.F90

    r14312 r14338  
    229229!!gm end modif 
    230230      END_3D 
    231       CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.0_wp,  zww, 'V', -1.0_wp )      ! lateral boundary conditions 
     231      CALL lbc_lnk( 'ldfslp', zwz, 'U', -1.0_wp,  zww, 'V', -1.0_wp )      ! lateral boundary conditions 
    232232      ! 
    233233      !                                    !* horizontal Shapiro filter 
    … …  
    289289!!gm end modif 
    290290      END_3D 
    291       CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1.0_wp,  zww, 'T', -1.0_wp )      ! lateral boundary conditions 
     291      CALL lbc_lnk( 'ldfslp', zwz, 'T', -1.0_wp,  zww, 'T', -1.0_wp )      ! lateral boundary conditions 
    292292      ! 
    293293      !                                           !* horizontal Shapiro filter 
    … …  
    318318      ! IV. Lateral boundary conditions 
    319319      ! =============================== 
    320       CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1.0_wp , vslp , 'V', -1.0_wp , wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
     320      CALL lbc_lnk( 'ldfslp', uslp , 'U', -1.0_wp , vslp , 'V', -1.0_wp , wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    321321 
    322322      IF(sn_cfctl%l_prtctl) THEN 
    … …  
    659659      END_2D 
    660660      !!gm this lbc_lnk should be useless.... 
    661       CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1.0_wp , vslpml , 'V', -1.0_wp , wslpiml, 'W', -1.0_wp , wslpjml, 'W', -1.0_wp )  
     661      CALL lbc_lnk( 'ldfslp', uslpml , 'U', -1.0_wp , vslpml , 'V', -1.0_wp , wslpiml, 'W', -1.0_wp , wslpjml, 'W', -1.0_wp )  
    662662      ! 
    663663   END SUBROUTINE ldf_slp_mxl 
    … …  
    727727!               END DO 
    728728!            END DO 
    729 !            CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1. ; CALL lbc_lnk( 'ldfslp', vslp , 'V', -1.,  wslpi, 'W', -1.,  wslpj, 'W', -1. ) 
     729!            CALL lbc_lnk( 'ldfslp', uslp , 'U', -1. ; CALL lbc_lnk( 'ldfslp', vslp , 'V', -1.,  wslpi, 'W', -1.,  wslpj, 'W', -1. ) 
    730730!!gm         ENDIF 
    731731      ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldftra.F90

    r14201 r14338  
    697697         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
    698698      END_2D 
    699       CALL lbc_lnk_multi( 'ldftra', paeiu(:,:,1), 'U', 1.0_wp , paeiv(:,:,1), 'V', 1.0_wp )      ! lateral boundary condition 
     699      CALL lbc_lnk( 'ldftra', paeiu(:,:,1), 'U', 1.0_wp , paeiv(:,:,1), 'V', 1.0_wp )      ! lateral boundary condition 
    700700 
    701701      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/geo2ocean.F90

    r14215 r14338  
    272272      ! =========================== ! 
    273273      !           ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    274       CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, &  
     274      CALL lbc_lnk( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, &  
    275275                      &   gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp  ) 
    276276      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcblk.F90

    r14072 r14338  
    830830 
    831831         IF( ln_crt_fbk ) THEN 
    832             CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 
     832            CALL lbc_lnk( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 
    833833         ELSE 
    834             CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     834            CALL lbc_lnk( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
    835835         ENDIF 
    836836 
    … …  
    10661066            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
    10671067         END_2D 
    1068          CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 
     1068         CALL lbc_lnk( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 
    10691069         ! 
    10701070         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbccpl.F90

    r14227 r14338  
    12481248                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    12491249               END_2D 
    1250                CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp ) 
     1250               CALL lbc_lnk( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp ) 
    12511251            ENDIF 
    12521252            llnewtx = .TRUE. 
    … …  
    16661666               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    16671667            END_2D 
    1668             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
     1668            CALL lbc_lnk( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    16691669         END SELECT 
    16701670 
    … …  
    25602560                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj) 
    25612561               END_2D 
    2562                CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 
     2562               CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 
    25632563            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    25642564               DO_2D( 0, 0, 0, 0 ) 
    … …  
    25692569               END_2D 
    25702570            END SELECT 
    2571             CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 
     2571            CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 
    25722572            ! 
    25732573         ENDIF 
    … …  
    26372637                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    26382638             END_2D 
    2639              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
     2639             CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
    26402640          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    26412641             DO_2D( 0, 0, 0, 0 ) 
    … …  
    26462646             END_2D 
    26472647          END SELECT 
    2648          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
     2648         CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
    26492649         ! 
    26502650         ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcflx.F90

    r14072 r14338  
    145145         ! 
    146146         ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 
    147          CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
     147         CALL lbc_lnk( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
    148148            &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    149149         ! 
    … …  
    172172      END_2D 
    173173      ! 
    174       CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
     174      CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 
    175175      ! 
    176176   END SUBROUTINE sbc_flx 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcice_cice.F90

    r14275 r14338  
    222222      END_2D 
    223223 
    224       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp,  fr_iv , 'V', 1.0_wp ) 
     224      CALL lbc_lnk( 'sbcice_cice', fr_iu , 'U', 1.0_wp,  fr_iv , 'V', 1.0_wp ) 
    225225 
    226226      ! set the snow+ice mass 
    … …  
    569569      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 
    570570       
    571       CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 
     571      CALL lbc_lnk( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 
    572572 
    573573! Solar penetrative radiation and non solar surface heat flux 
    … …  
    626626      END_2D 
    627627 
    628       CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 
     628      CALL lbc_lnk( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 
    629629 
    630630      ! set the snow+ice mass 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcwave.F90

    r14072 r14338  
    211211      ENDIF 
    212212 
    213       CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp ) 
     213      CALL lbc_lnk( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp ) 
    214214 
    215215      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv.F90

    r14189 r14338  
    182182         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    183183            IF (nn_hls.EQ.2) THEN 
    184                CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
    185                CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     184               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
     185               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    186186#if defined key_loop_fusion 
    187187               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    208208         CASE ( np_QCK )                                 ! QUICKEST 
    209209            IF (nn_hls.EQ.2) THEN 
    210                CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
     210               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    211211               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    212212            END IF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_cen.F90

    r14072 r14338  
    119119               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120120            END_3D 
    121             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
     121            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    122122            ! 
    123123            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
    … …  
    131131               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    132132            END_3D 
    133             IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
     133            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
    134134            ! 
    135135         CASE DEFAULT 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_fct.F90

    r14298 r14338  
    238238               END_2D 
    239239            END DO 
    240             CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     240            CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    241241            ! 
    242242            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    … …  
    247247               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) 
    248248            END_3D 
    249             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) 
     249            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    250250            ! 
    251251         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    … …  
    256256               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    257257            END_3D 
    258             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) 
     258            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    259259            ! 
    260260            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    268268               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    269269            END_3D 
    270             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) 
     270            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    271271            ! 
    272272         END SELECT 
    … …  
    292292         ! 
    293293         IF (nn_hls.EQ.1) THEN 
    294             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 ) 
     294            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    295295         ELSE 
    296296            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
    … …  
    449449         END_2D 
    450450      END DO 
    451       IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     451      IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    452452 
    453453      ! 3. monotonic flux in the i & j direction (paa & pbb) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_fct_lf.F90

    r14072 r14338  
    270270               END_2D 
    271271            END DO 
    272             CALL lbc_lnk_multi( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     272            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    273273!            ! 
    274274            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    … …  
    280280            END_3D 
    281281            ! 
    282             CALL lbc_lnk_multi( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     282            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    283283         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    284284            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    298298               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk) 
    299299            END_3D 
    300             CALL lbc_lnk_multi( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     300            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    301301            ! 
    302302         END SELECT 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_mus.F90

    r14072 r14338  
    140140         END_3D 
    141141         ! lateral boundary conditions   (changed sign) 
    142          IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
     142         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    143143         !                                !-- Slopes of tracer 
    144144         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    … …  
    176176            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    177177         END_3D 
    178          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) 
     178         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
    179179         ! 
    180180         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_qck.F90

    r14215 r14338  
    149149            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    150150         END_3D 
    151          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     151         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    152152 
    153153         ! 
    … …  
    167167         END_3D 
    168168         !--- Lateral boundary conditions 
    169          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
     169         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    170170 
    171171         !--- QUICKEST scheme 
    … …  
    239239            END_2D 
    240240         END DO 
    241          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     241         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    242242 
    243243         ! 
    … …  
    259259 
    260260         !--- Lateral boundary conditions 
    261          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
     261         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    262262 
    263263         !--- QUICKEST scheme 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_ubs.F90

    r14072 r14338  
    140140            ! 
    141141         END DO 
    142          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     142         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    143143         ! 
    144144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traatf.F90

    r14072 r14338  
    110110#endif 
    111111      !                                              ! local domain boundaries  (T-point, unchanged sign) 
    112       CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
     112      CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    113113      ! 
    114114      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
    … …  
    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 ) 
     158         CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
    159159 
    160160      ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traatf_qco.F90

    r14072 r14338  
    146146         ENDIF 
    147147         ! 
    148          CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
     148         CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
    149149         ! 
    150150      ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/trabbl.F90

    r14215 r14338  
    141141         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    142142            ! lateral boundary conditions ; just need for outputs 
    143             CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
     143            CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    144144            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    145145            CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    … …  
    522522      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    523523      zmbku(:,:) = REAL( mbku_d(:,:), wp )   ;     zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 
    524       CALL lbc_lnk_multi( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 
     524      CALL lbc_lnk( 'trabbl', zmbku,'U',1.0_wp, zmbkv,'V',1.0_wp) 
    525525      mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ;  mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 
    526526      ! 
    … …  
    541541         e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
    542542      END_2D 
    543       CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp )      ! lateral boundary conditions 
     543      CALL lbc_lnk( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp )      ! lateral boundary conditions 
    544544      ! 
    545545      !                             !* masked diffusive flux coefficients 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/tramle.F90

    r14210 r14338  
    361361               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    362362            END_2D 
    363             CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 
     363            CALL lbc_lnk( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 
    364364            ! 
    365365         ELSEIF( nn_mle == 1 ) THEN           ! MLE array allocation & initialisation 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/trazdf.F90

    r14189 r14338  
    102102         END DO 
    103103!!gm this should be moved in trdtra.F90 and done on all trends 
    104          CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1.0_wp , ztrds, 'T', 1.0_wp ) 
     104         CALL lbc_lnk( 'trazdf', ztrdt, 'T', 1.0_wp , ztrds, 'T', 1.0_wp ) 
    105105!!gm 
    106106         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/zpshde.F90

    r14189 r14338  
    173173      END DO 
    174174      ! 
    175       IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     175      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    176176      ! 
    177177      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    206206            ENDIF 
    207207         END_2D 
    208          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     208         IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    209209         ! 
    210210      END IF 
    … …  
    359359      END DO 
    360360      ! 
    361       IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     361      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    362362 
    363363      ! horizontal derivative of density anomalies (rd) 
    … …  
    401401         END_2D 
    402402 
    403          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     403         IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    404404         ! 
    405405      END IF 
    … …  
    452452         ! 
    453453      END DO 
    454       IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     454      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    455455 
    456456      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    491491 
    492492         END_2D 
    493          IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
     493         IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    494494         ! 
    495495      END IF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trddyn.F90

    r13497 r14338  
    128128                                 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) 
    129129                              END_3D 
    130                               CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
     130                              CALL lbc_lnk( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    131131                              CALL iom_put( "utrd_udx", z3dx  ) 
    132132                              CALL iom_put( "vtrd_vdy", z3dy  ) 
    … …  
    164164!                                 END DO 
    165165!                              END DO 
    166 !                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
     166!                              CALL lbc_lnk( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    167167!                              CALL iom_put( "utrd_bfr", z3dx ) 
    168168!                              CALL iom_put( "vtrd_bfr", z3dy ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdken.F90

    r13295 r14338  
    9090      !!---------------------------------------------------------------------- 
    9191      ! 
    92       CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp )      ! lateral boundary conditions 
     92      CALL lbc_lnk( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp )      ! lateral boundary conditions 
    9393      ! 
    9494      nkstp = kt 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdmxl.F90

    r13497 r14338  
    154154!!gm to be put juste before the output ! 
    155155!      ! Lateral boundary conditions 
    156 !      CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1.0_wp , smltrd(:,:,jl), 'T', 1.0_wp ) 
     156!      CALL lbc_lnk( 'trdmxl', tmltrd(:,:,jl), 'T', 1.0_wp , smltrd(:,:,jl), 'T', 1.0_wp ) 
    157157!!gm end 
    158158 
    … …  
    472472         !-- Lateral boundary conditions 
    473473         !         ... temperature ...                    ... salinity ... 
    474          CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, & 
     474         CALL lbc_lnk( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, & 
    475475                  &          ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, & 
    476476                  &          ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp ) 
    … …  
    523523         !-- Lateral boundary conditions 
    524524         !         ... temperature ...                    ... salinity ... 
    525          CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, & 
     525         CALL lbc_lnk( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, & 
    526526                  &          ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp ) 
    527527         ! 
    528          CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! /  in the NetCDF trends file 
     528         CALL lbc_lnk( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! /  in the NetCDF trends file 
    529529          
    530530         ! III.3 Time evolution array swap 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdvor.F90

    r13497 r14338  
    162162 
    163163      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp                    ! Initialisation 
    164       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )      ! lateral boundary condition 
     164      CALL lbc_lnk( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )      ! lateral boundary condition 
    165165       
    166166 
    … …  
    251251      zvdpvor(:,:) = 0._wp 
    252252      !                            ! lateral boundary condition on input momentum trends 
    253       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 
     253      CALL lbc_lnk( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 
    254254 
    255255      !  ===================================== 
    … …  
    400400 
    401401         ! Boundary conditions 
    402          CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
     402         CALL lbc_lnk( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
    403403 
    404404 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/USR/usrdef_sbc.F90

    r13295 r14338  
    181181         wndm(ji,jj) = SQRT( zmod * zcoef ) 
    182182      END_2D 
    183       CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1.0_wp , wndm(:,:), 'T', 1.0_wp ) 
     183      CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1.0_wp , wndm(:,:), 'T', 1.0_wp ) 
    184184 
    185185      ! ---------------------------------- ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfmfc.F90

    r14072 r14338  
    376376      ! 
    377377      ! 
    378       CALL lbc_lnk_multi( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
     378      CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
    379379      ! 
    380380   END SUBROUTINE tra_mfc 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfosm.F90

    r14215 r14338  
    11631163     END_3D 
    11641164      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    1165      CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
     1165     CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
    11661166      &                  ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 
    11671167       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    … …  
    11761176       END_3D 
    11771177        ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
    1178         CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
     1178        CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
    11791179        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    11801180        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
    1181         CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
     1181        CALL lbc_lnk( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
    11821182         &                            ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 
    11831183 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfphy.F90

    r14072 r14338  
    323323      !                                         !* Lateral boundary conditions (sign unchanged) 
    324324      IF( l_zdfsh2 ) THEN 
    325          CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
     325         CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    326326            &                avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    327327      ELSE 
    328          CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     328         CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    329329      ENDIF 
    330330      ! 
    331331      IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    332          IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
     332         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
    333333         ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only 
    334334         ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/stpmlf.F90

    r14239 r14338  
    508508# endif 
    509509      !                                        ! local domain boundaries  (T-point, unchanged sign) 
    510       CALL lbc_lnk_multi( 'finalize_lbc', puu(:,:,:,       Kaa), 'U', -1., pvv(:,:,:       ,Kaa), 'V', -1.   & 
     510      CALL lbc_lnk( 'finalize_lbc', puu(:,:,:,       Kaa), 'U', -1., pvv(:,:,:       ,Kaa), 'V', -1.   & 
    511511                       &                , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
    512512      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/SWE/stpmlf.F90

    r14319 r14338  
    197197      ENDIF 
    198198 
    199       CALL lbc_lnk_multi( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.,   &   !* local domain boundaries 
     199      CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.,   &   !* local domain boundaries 
    200200         &                           uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1.    )      
    201201 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/SWE/stprk3.F90

    r14319 r14338  
    171171      ENDIF 
    172172      ! 
    173       CALL lbc_lnk_multi( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     173      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    174174      ! 
    175175      !                                 !==  Swap time levels  ==! 
    … …  
    236236      ENDIF 
    237237      ! 
    238       CALL lbc_lnk_multi( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     238      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    239239      ! 
    240240      !                                 !==  Swap time levels  ==! 
    … …  
    299299      ENDIF 
    300300      ! 
    301       CALL lbc_lnk_multi( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     301      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    302302      ! 
    303303      !                                 !==  Swap time levels  ==! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/PISCES/P2Z/p2zbio.F90

    r13295 r14338  
    340340      IF( lk_iomput ) THEN 
    341341         CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1.0_wp ) 
    342          CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp ) 
     342         CALL lbc_lnk( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp ) 
    343343         ! Save diagnostics 
    344344         CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/TRP/trcadv.F90

    r14086 r14338  
    131131      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    132132         IF (nn_hls.EQ.2) THEN 
    133             CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
    134             CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     133            CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
     134            CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    135135#if defined key_loop_fusion 
    136136            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    157157      CASE ( np_QCK )                                 ! QUICKEST 
    158158         IF (nn_hls.EQ.2) THEN 
    159             CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
     159            CALL lbc_lnk( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    160160            CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    161161         END IF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/TRP/trdmxl_trc.F90

    r13497 r14338  
    419419         !-- Lateral boundary conditions 
    420420               IF ( cn_cfg .NE. 'gyre' ) THEN 
    421                   CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., & 
     421                  CALL lbc_lnk( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., & 
    422422                     &                ztmlatf(:,:,jn) , 'T', 1. , ztmlrad(:,:,jn) , 'T', 1. ) 
    423423               ENDIF 
    … …  
    470470         !-- Lateral boundary conditions  
    471471               IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
    472                   CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. ) 
     472                  CALL lbc_lnk( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. ) 
    473473                  DO jl = 1, jpltrd_trc 
    474474                     CALL lbc_lnk( 'trdmxl_trc', ztmltrd2(:,:,jl,jn), 'T', 1. )       ! will be output in the NetCDF trends file 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/BENCH/MY_SRC/usrdef_nam.F90

    r14336 r14338  
    5555      !                              !!* nammpp namelist *!! 
    5656      INTEGER          ::   jpni, jpnj 
    57       LOGICAL          ::   ln_nnogather, ln_listonly 
     57      LOGICAL          ::   ln_listonly 
    5858      LOGICAL          ::   ln_Iperio, ln_Jperio 
    5959      LOGICAL          ::   ln_NFold 
    … …  
    6161      !! 
    6262      NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, ln_Iperio, ln_Jperio, ln_NFold, cn_NFtype 
    63       NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 
     63      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm 
    6464      !!----------------------------------------------------------------------      
    6565      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/BENCH/MY_SRC/usrdef_sbc.F90

    r14273 r14338  
    110110      END_2D 
    111111 
    112       CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
     112      CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    113113#endif 
    114114      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/CANAL/MY_SRC/usrdef_istate.F90

    r14224 r14338  
    239239      ! 
    240240      CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. ) 
    241       CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     241      CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    242242 
    243243   END SUBROUTINE usr_def_istate 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/DOME/MY_SRC/usrdef_zgr.F90

    r14336 r14338  
    9898         END DO 
    9999      END DO 
    100       CALL lbc_lnk_multi( 'usrdef_zgr', zhu, 'U', 1.0_wp, zhv, 'V', 1.0_wp, zhf, 'F', 1.0_wp)       
     100      CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1.0_wp, zhv, 'V', 1.0_wp, zhf, 'F', 1.0_wp)       
    101101      !      
    102102      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90

    r14120 r14338  
    354354 
    355355      END_2D 
    356       CALL lbc_lnk_multi( 'icedyn_rhg_eap', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
     356      CALL lbc_lnk( 'icedyn_rhg_eap', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    357357      ! 
    358358      !                                  !== Landfast ice parameterization ==! 
    … …  
    492492            zs2(ji,jj) = ( zs2(ji,jj) * zalph1 + zstressmtmp ) * z1_alph1 
    493493         END_2D 
    494          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp) 
     494         CALL lbc_lnk( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp) 
    495495 
    496496        ! Save beta at T-points for further computations 
    … …  
    520520 
    521521         END_2D 
    522          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
     522         CALL lbc_lnk( 'icedyn_rhg_eap', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
    523523 
    524524         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    … …  
    832832 
    833833      END_2D 
    834       CALL lbc_lnk_multi( 'icedyn_rhg_eap', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp, & 
     834      CALL lbc_lnk( 'icedyn_rhg_eap', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp, & 
    835835         &                                    zten_i, 'T', 1.0_wp, zs1    , 'T', 1.0_wp, zs2     , 'T', 1.0_wp, & 
    836836         &                                      zs12, 'F', 1.0_wp ) 
    … …  
    849849         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    850850         ! 
    851          CALL lbc_lnk_multi( 'icedyn_rhg_eap', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, & 
     851         CALL lbc_lnk( 'icedyn_rhg_eap', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, & 
    852852            &                                  ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    853853         ! 
    … …  
    934934      IF( iom_use('yield11') .OR. iom_use('yield12') .OR. iom_use('yield22')) THEN 
    935935 
    936          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
     936         CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
    937937 
    938938         CALL iom_put( 'yield11', zyield11 * aimsk00 ) 
    … …  
    951951         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    952952         ! 
    953          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     953         CALL lbc_lnk( 'icedyn_rhg_eap', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
    954954            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, & 
    955955            &                                    zfU, 'U', -1.0_wp,   zfV, 'V', -1.0_wp ) 
    … …  
    985985         END_2D 
    986986 
    987          CALL lbc_lnk_multi( 'icedyn_rhg_eap', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     987         CALL lbc_lnk( 'icedyn_rhg_eap', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
    988988            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
    989989            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90

    r14021 r14338  
    320320 
    321321      END_2D 
    322       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
     322      CALL lbc_lnk( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    323323      ! 
    324324      !                                  !== Landfast ice parameterization ==! 
    … …  
    770770 
    771771      END_2D 
    772       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 
     772      CALL lbc_lnk( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 
    773773         &                                  zs1     , 'T', 1._wp, zs2    , 'T', 1._wp, zs12    , 'F', 1._wp ) 
    774774       
    … …  
    786786         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    787787         ! 
    788          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
     788         CALL lbc_lnk( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
    789789            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    790790         ! 
    … …  
    871871         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    872872         ! 
    873          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     873         CALL lbc_lnk( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
    874874            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 
    875875 
    … …  
    904904         END_2D 
    905905 
    906          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     906         CALL lbc_lnk( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
    907907            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
    908908            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90

    r14273 r14338  
    126126         windv(ji,jj) = Umax/sqrt(d*1000)*(d-2*mjg(jj)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*Rwind*min(kt*30./21600,1.) 
    127127      END_2D 
    128       CALL lbc_lnk_multi( 'usrdef_sbc', windu, 'U', -1., windv, 'V', -1. ) 
     128      CALL lbc_lnk( 'usrdef_sbc', windu, 'U', -1., windv, 'V', -1. ) 
    129129 
    130130      wndm_ice(:,:) = 0._wp      !!gm brutal.... 
    … …  
    156156            &          * ( 0.5 * (windv(ji,jj+1) + windv(ji,jj) ) - r_vfac * v_ice(ji,jj) ) 
    157157      END_2D 
    158       CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
     158      CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    159159      ! 
    160160   END SUBROUTINE usrdef_sbc_ice_tau 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/STATION_ASF/MY_SRC/icesbc.F90

    r14072 r14338  
    9191         vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    9292         END_2D 
    93          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
     93         CALL lbc_lnk( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
    9494      ENDIF 
    9595      ! 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/SWG/MY_SRC/usrdef_sbc.F90

    r13752 r14338  
    104104      END DO 
    105105       
    106       CALL lbc_lnk_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
     106      CALL lbc_lnk( 'usrdef_sbc', taum(:,:), 'T', 1. , wndm(:,:), 'T', 1. ) 
    107107      ! 
    108108   END SUBROUTINE usrdef_sbc_oce 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/tests/VORTEX/MY_SRC/usrdef_istate.F90

    r14133 r14338  
    123123      END_2D 
    124124      ! 
    125       CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     125      CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
    126126      !    
    127127   END SUBROUTINE usr_def_istate 
Note: See TracChangeset for help on using the changeset viewer.