Changeset 14338
- Timestamp:
- 2021-01-25T08:50:49+01:00 (3 years ago)
- 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 1498 1498 jpnj = 0 ! number of processors following j (set automatically if < 1), see also ln_listonly = T 1499 1499 nn_hls = 1 ! halo width (applies to both rows and columns) 1500 nn_comm = 1 ! comm choice 1500 1501 / 1501 1502 !----------------------------------------------------------------------- -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ABL/ablmod.F90
r14239 r14338 534 534 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 535 535 ! 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... 538 538 ! 539 539 #if defined key_xios … … 600 600 END_2D 601 601 ! 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 ) 603 603 ! 604 604 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) … … 625 625 END_2D 626 626 ! 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 ) 628 628 629 629 CALL iom_put( "taum_oce", ptaum ) … … 645 645 & * ( 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) - pssv_ice(ji,jj) ) 646 646 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 ) 648 648 ! 649 649 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=ptaui_ice , clinfo1=' abl_stp: putaui : ' & … … 664 664 & * ( zztmp2 - pssv_ice(ji,jj) ) 665 665 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 ) 667 667 ! 668 668 IF(sn_cfctl%l_prtctl) THEN -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icecor.F90
r13641 r14338 116 116 ENDIF 117 117 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 ) 119 119 ENDIF 120 120 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_adv_pra.F90
r14215 r14338 115 115 CALL icemax3D( ph_ip, zhip_max) 116 116 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 ) 118 118 ! 119 119 ! enthalpies … … 265 265 ! --- Lateral boundary conditions --- ! 266 266 ! 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 volume267 CALL lbc_lnk( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume 268 268 & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp & 269 269 & , z0snw , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume 270 270 & , 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 salinity271 CALL lbc_lnk( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity 272 272 & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp & 273 273 & , z0ai , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration 274 274 & , 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 age275 CALL lbc_lnk( 'icedyn_adv_pra', z0oi , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age 276 276 & , 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 enthalpy277 CALL lbc_lnk( 'icedyn_adv_pra', z0es , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy 278 278 & , 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 enthalpy279 CALL lbc_lnk( 'icedyn_adv_pra', z0ei , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy 280 280 & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp ) 281 281 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 fraction282 CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction 283 283 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & 284 284 & , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume 285 285 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp ) 286 286 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 volume287 CALL lbc_lnk( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp & ! melt pond lid volume 288 288 & , sxxvl,'T', 1._wp, syyvl,'T', 1._wp, sxyvl,'T', 1._wp ) 289 289 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_adv_umx.F90
r14215 r14338 119 119 CALL icemax3D( ph_ip, zhip_max) 120 120 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 ) 122 122 ! 123 123 ! enthalpies … … 360 360 ! --- Lateral boundary conditions --- ! 361 361 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 & 363 363 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 364 364 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 & 366 366 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 367 367 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 ) 369 369 ENDIF 370 370 CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) … … 1169 1169 END_2D 1170 1170 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 ) 1172 1172 1173 1173 DO jl = 1, jpl … … 1191 1191 END_2D 1192 1192 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. 1194 1194 1195 1195 ENDIF … … 1248 1248 END_2D 1249 1249 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) 1251 1251 1252 1252 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icedyn_rhg_eap.F90
r14120 r14338 350 350 351 351 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 ) 353 353 ! 354 354 ! !== Landfast ice parameterization ==! … … 488 488 zs2(ji,jj) = ( zs2(ji,jj) * zalph1 + zstressmtmp ) * z1_alph1 489 489 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) 491 491 492 492 ! Save beta at T-points for further computations … … 516 516 517 517 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 ) 519 519 520 520 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! … … 810 810 811 811 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, & 813 813 & zten_i, 'T', 1.0_wp, zs1 , 'T', 1.0_wp, zs2 , 'T', 1.0_wp, & 814 814 & zs12, 'F', 1.0_wp ) … … 827 827 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 828 828 ! 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, & 830 830 & ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 831 831 ! … … 912 912 IF( iom_use('yield11') .OR. iom_use('yield12') .OR. iom_use('yield22')) THEN 913 913 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 ) 915 915 916 916 CALL iom_put( 'yield11', zyield11 * aimsk00 ) … … 929 929 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 930 930 ! 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, & 932 932 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, & 933 933 & zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) … … 963 963 END_2D 964 964 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, & 966 966 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 967 967 & 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 316 316 317 317 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 ) 319 319 ! 320 320 ! !== Landfast ice parameterization ==! … … 750 750 751 751 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, & 753 753 & zs1 , 'T', 1._wp, zs2 , 'T', 1._wp, zs12 , 'F', 1._wp ) 754 754 … … 766 766 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 767 767 ! 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, & 769 769 & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 770 770 ! … … 851 851 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 852 852 ! 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, & 854 854 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 855 855 … … 884 884 END_2D 885 885 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, & 887 887 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 888 888 & 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 506 506 END DO 507 507 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. ) 509 509 510 510 CALL iom_put( 'zzt' , zzt ) ! MV DEBUG … … 567 567 IF( lwp ) WRITE(numout,*) ' outer loop 1d i_out : ', i_out 568 568 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. ) 571 571 572 572 CALL iom_put( 'zCwU' , zCwU ) ! MV DEBUG … … 674 674 END DO 675 675 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.) 679 679 680 680 CALL iom_put( 'zmU_t' , zmU_t ) ! MV DEBUG … … 779 779 END DO 780 780 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. ) 786 786 787 787 CALL iom_put( 'zAU' , zAU ) ! MV DEBUG … … 885 885 END DO 886 886 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. ) 888 888 889 889 !----------------------------- … … 965 965 END DO 966 966 967 CALL lbc_lnk _multi( 'icedyn_rhg_vp', zFV, 'V', 1.)967 CALL lbc_lnk( 'icedyn_rhg_vp', zFV, 'V', 1.) 968 968 969 969 !--------------- … … 983 983 END DO 984 984 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. ) 986 986 987 987 !----------------------------- … … 1020 1020 ENDIF ! ll_v_iterate 1021 1021 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. ) 1023 1023 1024 1024 !-------------------------------------------------------------------------------------- … … 1110 1110 IF ( lwp ) WRITE(numout,*) ' We are out of outer loop ' 1111 1111 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. ) 1116 1116 1117 1117 CALL iom_put( 'zFU' , zFU ) ! MV DEBUG … … 1125 1125 CALL iom_put( 'zFV_prime' , zFV_prime ) ! MV DEBUG 1126 1126 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. ) 1128 1128 1129 1129 IF ( lwp ) WRITE(numout,*) ' We are about to output uice_dbg ' … … 1161 1161 END DO 1162 1162 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. ) 1164 1164 1165 1165 IF ( lwp ) WRITE(numout,*) ' Velocity replaced ' … … 1222 1222 IF ( lwp ) WRITE(numout,*) ' Deformation recalculated ' 1223 1223 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. ) 1225 1225 1226 1226 !------------------------------------------------------------------------------! … … 1249 1249 END DO 1250 1250 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. ) 1252 1252 1253 1253 ENDIF … … 1307 1307 1308 1308 ! 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. ) !, & 1310 1310 ! & ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 1311 1311 ! … … 1348 1348 END DO 1349 1349 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.) 1351 1351 1352 1352 IF( iom_use('normstr') ) CALL iom_put( 'normstr' , zsig_I(:,:) * zmsk00(:,:) ) ! Normal stress … … 1393 1393 IF ( lwp ) WRITE(numout,*) 'Some shitty stress work done' 1394 1394 ! 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.) 1396 1396 ! 1397 1397 IF ( lwp ) WRITE(numout,*) ' Beauaaaarflblbllll ' … … 1423 1423 END DO 1424 1424 ! 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., & 1426 1426 & zCorU, 'U', -1., zCorV, 'V', -1. ) 1427 1427 ! … … 1453 1453 END DO 1454 1454 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. ) 1456 1456 1457 1457 CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x) … … 1485 1485 END DO 1486 1486 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., & 1488 1488 & zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 1489 1489 & zdiag_xatrp , 'U', -1., zdiag_yatrp , 'V', -1. ) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icesbc.F90
r14072 r14338 87 87 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 88 88 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 ) 90 90 ENDIF 91 91 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icethd.F90
r14072 r14338 136 136 END_2D 137 137 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 ) 139 139 ! 140 140 !--------------------------------------------------------------------! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/icethd_do.F90
r13601 r14338 193 193 END_2D 194 194 ! 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 ) 196 196 197 197 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/ICE/iceupdate.F90
r14072 r14338 345 345 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 346 346 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 ) 348 348 ! 349 349 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step … … 374 374 vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 375 375 END_2D 376 CALL lbc_lnk _multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition376 CALL lbc_lnk( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition 377 377 ! 378 378 IF( ln_timing ) CALL timing_stop('ice_update') -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_oce_interp.F90
r14227 r14338 109 109 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 110 110 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 ) 112 112 CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 113 113 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_oce_sponge.F90
r14227 r14338 236 236 END_2D 237 237 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 ) 239 239 ! 240 240 ! Remove vertical interpolation where not needed: … … 368 368 fspf_2d(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1) 369 369 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 ) 371 371 ! 372 372 #endif -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/NST/agrif_user.F90
r14336 r14338 209 209 ENDIF 210 210 ! 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 ) 212 212 DO_2D( 0, 0, 0, 0 ) 213 213 zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) … … 251 251 ENDIF 252 252 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 ) 254 254 ENDIF 255 255 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdydyn2d.F90
r13226 r14338 18 18 USE bdylib ! BDY library routines 19 19 USE phycst ! physical constants 20 USE lib_mpp, ONLY: jpfillnothing 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 22 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 15 15 USE bdy_oce ! ocean open boundary conditions 16 16 USE bdylib ! for orlanski library routines 17 USE lib_mpp, ONLY: jpfillnothing 17 18 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 18 19 USE in_out_manager ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyice.F90
r13601 r14338 92 92 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 93 93 ! 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 & 95 95 & , 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 & 96 96 & , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp & 97 97 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 98 98 ! 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 ) 101 101 END IF 102 102 END DO ! ir -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyini.F90
r14336 r14338 652 652 END DO 653 653 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. 655 655 656 656 ! 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 18 18 ! 19 19 USE in_out_manager ! I/O manager 20 USE lib_mpp, ONLY: jpfillnothing 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 22 USE lib_mpp, ONLY: ctl_stop -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/CRS/crslbclnk.F90
r11536 r14338 50 50 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 51 51 ! 52 CALL lbc_lnk( 'crslbclnk', pt3d1, cd_type1, psgn, kfillmode ,pfillval )52 CALL lbc_lnk( 'crslbclnk', pt3d1, cd_type1, psgn, kfillmode = kfillmode, pfillval = pfillval ) 53 53 ! 54 54 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain … … 80 80 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 81 81 ! 82 CALL lbc_lnk( 'crslbclnk', pt2d, cd_type, psgn, kfillmode ,pfillval )82 CALL lbc_lnk( 'crslbclnk', pt2d, cd_type, psgn, kfillmode = kfillmode, pfillval = pfillval ) 83 83 ! 84 84 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 162 162 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 163 163 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 conditions164 CALL lbc_lnk( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp ) ! Lateral boundary conditions 165 165 166 166 ! 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 170 170 ! 171 171 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 ) 173 173 ! 174 174 ! … … 194 194 #endif 195 195 ! ! 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 ) 197 197 ! 198 198 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domvvl.F90
r14326 r14338 423 423 ! ! d - thickness diffusion transport: boundary conditions 424 424 ! (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) 426 426 ! 4 - Time stepping of baroclinic scale factors 427 427 ! --------------------------------------------- -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynadv_ubs.F90
r13497 r14338 124 124 END_2D 125 125 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, & 127 127 & zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp, & 128 128 & 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 169 169 # endif 170 170 ! 171 CALL lbc_lnk _multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries171 CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries 172 172 ! 173 173 ! !* BDY open boundaries -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynhpg.F90
r14227 r14338 462 462 END IF 463 463 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 ) 465 465 END IF 466 466 ! … … 689 689 END IF 690 690 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 ) 692 692 END IF 693 693 … … 793 793 END_3D 794 794 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. ) 796 796 797 797 !------------------------------------------------------------------------- … … 1043 1043 ENDIF 1044 1044 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 ) 1046 1046 ENDIF 1047 1047 … … 1113 1113 END_2D 1114 1114 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 ) 1116 1116 1117 1117 DO_2D( 0, 0, 0, 0 ) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynldf_iso.F90
r14215 r14338 135 135 END_3D 136 136 ! 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 ) 138 138 ! 139 139 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynldf_lap_blp.F90
r14053 r14338 185 185 CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt (output in zlap,Kbb) 186 186 ! 187 CALL lbc_lnk _multi( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions187 CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions 188 188 ! 189 189 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 524 524 END_2D 525 525 ! 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 ) 527 527 ! 528 528 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) … … 677 677 ! 678 678 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 & 680 680 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & 681 681 & , hur_e, 'U', 1._wp, hvr_e, 'V', 1._wp ) 682 682 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 ) 684 684 ENDIF 685 685 ! ! open boundaries … … 775 775 END_2D 776 776 #endif 777 CALL lbc_lnk _multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions777 CALL lbc_lnk( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 778 778 ! 779 779 DO jk=1,jpkm1 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/dynvor.F90
r14233 r14338 940 940 dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji ,jj-1) ) * 0.5_wp 941 941 END_2D 942 CALL lbc_lnk _multi( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp ) ! Lateral boundary conditions942 CALL lbc_lnk( 'dynvor', di_e2u_2, 'T', -1.0_wp , dj_e1v_2, 'T', -1.0_wp ) ! Lateral boundary conditions 943 943 ! 944 944 CASE DEFAULT !* F-point metric term : pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) … … 948 948 dj_e1u_2e1e2f(ji,jj) = ( e1u(ji ,jj+1) - e1u(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) 949 949 END_2D 950 CALL lbc_lnk _multi( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp ) ! Lateral boundary conditions950 CALL lbc_lnk( 'dynvor', di_e2v_2e1e2f, 'F', -1.0_wp , dj_e1u_2e1e2f, 'F', -1.0_wp ) ! Lateral boundary conditions 951 951 END SELECT 952 952 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DYN/wet_dry.F90
r13558 r14338 241 241 ENDIF 242 242 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 ) 244 244 ! 245 245 CALL mpp_max('wet_dry', jflag) !max over the global domain … … 257 257 ! 258 258 !!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 ) 261 261 !!gm 262 262 ! … … 366 366 END_2D 367 367 ! 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 ) 369 369 ! 370 370 CALL mpp_max('wet_dry', jflag) !max over the global domain … … 378 378 ! 379 379 !!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 ) 381 381 !!gm end 382 382 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfcav.F90
r14072 r14338 136 136 ! 137 137 ! 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) 139 139 ! 140 140 ! output fluxes -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfcpl.F90
r14143 r14338 205 205 zssmask0(:,:) = zssmask_b(:,:) 206 206 ! 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 ) 208 208 ! 209 209 END DO … … 363 363 ztmask0(:,:,:) = ztmask1(:,:,:) 364 364 ! 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) 366 366 ! 367 367 END DO ! nn_drown … … 691 691 ! 692 692 ! 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, & 694 694 & risfcpl_cons_vol(:,:,:) , 'T', 1.0_wp) 695 695 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ISF/isfpar.F90
r13226 r14338 82 82 ! 83 83 ! 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) 85 85 ! 86 86 ! 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 :,:,:,: 35 15 #endif 36 16 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 ) 43 24 !!--------------------------------------------------------------------- 44 25 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 45 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1! arrays on which the lbc is applied46 ARRAY_TYPE(:,:,:,:) , OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9, &47 & pt10 , pt11 , pt12 , pt13 , pt14 , pt15, pt1626 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 48 29 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 49 30 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & … … 58 39 !! 59 40 INTEGER :: kfld ! number of elements that will be attributed 60 PTR_TYPE, DIMENSION(16) :: ptab_ptr ! pointer array41 TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(16) :: ptab_ptr ! pointer array 61 42 CHARACTER(len=1) , DIMENSION(16) :: cdna_ptr ! nature of ptab_ptr grid-points 62 43 REAL(PRECISION) , DIMENSION(16) :: psgn_ptr ! sign used across the north fold boundary … … 66 47 ! 67 48 ! ! 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 ) 69 50 ! 70 51 ! ! 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 ) 86 67 ! 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 88 73 ! 89 END SUBROUTINE ROUTINE_MULTI74 END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION 90 75 91 76 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 ) 93 78 !!--------------------------------------------------------------------- 94 ARRAY_TYPE(:,:,:,:), TARGET, INTENT(inout) :: ptab ! arrays on which the lbc is applied79 REAL(PRECISION), DIMENSION(DIMS1), TARGET, INTENT(inout) :: ptab ! arrays on which the lbc is applied 95 80 CHARACTER(len=1) , INTENT(in ) :: cdna ! nature of pt2d array grid-points 96 81 REAL(PRECISION) , INTENT(in ) :: psgn ! sign used across the north fold boundary 97 PTR_TYPE, DIMENSION(:), INTENT(inout) :: ptab_ptr ! array of pointers82 TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab_ptr ! array of pointers 98 83 CHARACTER(len=1), DIMENSION(:), INTENT(inout) :: cdna_ptr ! nature of pt2d_array array grid-points 99 84 REAL(PRECISION) , DIMENSION(:), INTENT(inout) :: psgn_ptr ! sign used across the north fold boundary … … 102 87 ! 103 88 kfld = kfld + 1 104 ptab_ptr(kfld)% PTR_ptab=> ptab89 ptab_ptr(kfld)%pt/**/XD => ptab 105 90 cdna_ptr(kfld) = cdna 106 91 psgn_ptr(kfld) = psgn 107 92 ! 108 END SUBROUTINE ROUTINE_LOAD93 END SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION 109 94 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 ) 46 22 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 49 27 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 50 28 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) … … 261 239 ! 262 240 IF( ll_IdoNFold ) THEN 263 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:)) ! self NFold264 ELSE ; CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:)) ! mpi NFold241 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 265 243 ENDIF 266 244 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 274 249 #undef ARRAY_IN 275 250 #undef K_SIZE 276 251 #undef L_SIZE 277 252 #undef F_SIZE 278 #undef OPT_K279 #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 62 20 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 ) 80 22 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 83 27 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 84 28 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 85 29 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 86 LOGICAL, OPTIONAL, INTENT(in ) :: ncsten ! 5-point or 9-point stencil87 30 ! 88 31 INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices … … 91 34 INTEGER :: ip0j, ip1j, im0j, im1j 92 35 INTEGER :: ishti, ishtj, ishti2, ishtj2 93 INTEGER :: i err36 INTEGER :: icomm, ierr 94 37 INTEGER :: idxs, idxr 95 38 INTEGER, DIMENSION(4) :: isizei, ishtsi, ishtri, ishtpi … … 110 53 #endif 111 54 ! 112 #if defined key_mpi3113 # if defined MULTI114 CALL lbc_lnk_nc ( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten )115 # else116 CALL lbc_lnk_nc_multi(cdname, ptab, cd_nat, psgn, kfillmode=kfillmode, pfillval=pfillval, lsend=lsend, lrecv=lrecv, ncsten=ncsten)117 # endif118 #else119 55 ! ----------------------------------------- ! 120 56 ! 1. local variables initialization ! … … 212 148 END DO 213 149 ! 150 #if ! defined key_mpi_off 214 151 IF( ln_timing ) CALL tic_tac(.TRUE.) 215 152 ! 153 icomm = mpi_comm_oce ! shorter name 216 154 ! 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 ) 219 159 ! 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 ) 222 164 ! 223 165 IF( ln_timing ) CALL tic_tac(.FALSE.) 166 #endif 224 167 ! 225 168 ! ----------------------------------- ! … … 264 207 ! 265 208 IF( ll_IdoNFold ) THEN 266 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:)) ! self NFold267 ELSE ; CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill(jpno), zland OPT_K(:)) ! mpi NFold209 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 268 211 ENDIF 269 212 ENDIF … … 284 227 END DO 285 228 ! 229 #if ! defined key_mpi_off 286 230 IF( ln_timing ) CALL tic_tac(.TRUE.) 287 231 ! 288 232 ! 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 ) 291 237 ! 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 ) 294 242 ! 295 243 IF( ln_timing ) CALL tic_tac(.FALSE.) 244 #endif 296 245 ! 297 246 ! ------------------------------------- ! … … 335 284 DEALLOCATE( zsnd, zrcv ) 336 285 ! 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 345 289 #undef ARRAY_IN 346 290 #undef K_SIZE 347 291 #undef L_SIZE 348 292 #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_nat3 #define SGN_IN(k) psgn4 #define F_SIZE(ptab) 15 1 #if defined DIM_2d 2 # define XD 2d 6 3 # define ARRAY_IN(i,j,k,l,f) ptab(i,j) 7 4 # define K_SIZE(ptab) 1 8 5 # define L_SIZE(ptab) 1 6 #else 7 === NOT CODED === 9 8 #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 17 10 18 SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )11 SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION( ptab, cd_nat, psgn, kextj ) 19 12 !!---------------------------------------------------------------------- 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 24 18 ! 25 19 INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices … … 31 25 ipl = L_SIZE(ptab) ! 4th - 32 26 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 33 !34 27 ! 35 28 SELECT CASE ( jpni ) … … 45 38 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 46 39 ! 47 SELECT CASE ( NAT_IN(jf))40 SELECT CASE ( cd_nat ) 48 41 CASE ( 'T' , 'W' ) ! T-, W-point 49 42 DO jh = 0, kextj 50 43 DO ji = 2, jpiglo 51 44 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) 53 46 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) 55 48 END DO 56 49 DO ji = jpiglo/2+1, jpiglo 57 50 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) 59 52 END DO 60 53 CASE ( 'U' ) ! U-point … … 62 55 DO ji = 2, jpiglo-1 63 56 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) 65 58 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) 68 61 END DO 69 62 DO ji = jpiglo/2, jpiglo-1 70 63 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) 72 65 END DO 73 66 CASE ( 'V' ) ! V-point … … 75 68 DO ji = 2, jpiglo 76 69 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) 79 72 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) 81 74 END DO 82 75 CASE ( 'F' ) ! F-point … … 84 77 DO ji = 1, jpiglo-1 85 78 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) 88 81 END DO 89 82 END DO 90 83 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) 93 86 END DO 94 87 END SELECT … … 98 91 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 99 92 ! 100 SELECT CASE ( NAT_IN(jf))93 SELECT CASE ( cd_nat ) 101 94 CASE ( 'T' , 'W' ) ! T-, W-point 102 95 DO jh = 0, kextj 103 96 DO ji = 1, jpiglo 104 97 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) 106 99 END DO 107 100 END DO … … 110 103 DO ji = 1, jpiglo-1 111 104 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) 113 106 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) 115 108 END DO 116 109 CASE ( 'V' ) ! V-point … … 118 111 DO ji = 1, jpiglo 119 112 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) 121 114 END DO 122 115 END DO 123 116 DO ji = jpiglo/2+1, jpiglo 124 117 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) 126 119 END DO 127 120 CASE ( 'F' ) ! F-point … … 129 122 DO ji = 1, jpiglo-1 130 123 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) 132 125 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) 134 127 END DO 135 128 DO ji = jpiglo/2+1, jpiglo-1 136 129 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) 138 131 END DO 139 132 END SELECT … … 143 136 END DO 144 137 ! 145 END SUBROUTINE ROUTINE_NFD138 END SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION 146 139 147 #undef PRECISION 148 #undef ARRAY_TYPE 140 #undef XD 149 141 #undef ARRAY_IN 150 #undef NAT_IN151 #undef SGN_IN152 142 #undef K_SIZE 153 143 #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 66 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 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 67 23 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 83 29 ! 84 30 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices … … 96 42 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 97 43 ! 98 SELECT CASE ( NAT_IN(jf))44 SELECT CASE ( cd_nat(jf) ) 99 45 CASE ( 'T' , 'W' ) ! T-, W-point 100 46 DO jl = 1, ipl; DO jk = 1, ipk … … 108 54 ii1 = ji ! ends at: nn_hls 109 55 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) 111 57 END DO 112 58 DO ji = 1, 1 ! point nn_hls+1 113 59 ii1 = nn_hls + ji 114 60 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) 116 62 END DO 117 63 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 118 64 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 119 65 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) 121 67 END DO 122 68 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 123 69 ii1 = jpiglo - nn_hls + ji 124 70 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) 126 72 END DO 127 73 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 128 74 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 129 75 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) 131 77 END DO 132 78 END DO … … 140 86 ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls 141 87 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) 143 89 END DO 144 90 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) … … 146 92 ii1 = ji ! ends at: nn_hls 147 93 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) 149 95 END DO 150 96 ! ! last nn_hls-1 points: have been / will done by e-w periodicity … … 163 109 ii1 = ji ! ends at: nn_hls 164 110 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) 166 112 END DO 167 113 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 168 114 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 169 115 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) 171 117 END DO 172 118 DO ji = 1, nn_hls ! last nn_hls points 173 119 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 174 120 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) 176 122 END DO 177 123 END DO … … 185 131 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 186 132 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) 188 134 END DO 189 135 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) … … 191 137 ii1 = ji ! ends at: nn_hls 192 138 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) 194 140 END DO 195 141 ! ! last nn_hls-1 points: have been / will done by e-w periodicity … … 208 154 ii1 = ji ! ends at: nn_hls 209 155 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) 211 157 END DO 212 158 DO ji = 1, 1 ! point nn_hls+1 213 159 ii1 = nn_hls + ji 214 160 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) 216 162 END DO 217 163 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 218 164 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 219 165 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) 221 167 END DO 222 168 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 223 169 ii1 = jpiglo - nn_hls + ji 224 170 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) 226 172 END DO 227 173 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 228 174 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 229 175 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) 231 177 END DO 232 178 END DO … … 244 190 ii1 = ji ! ends at: nn_hls 245 191 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) 247 193 END DO 248 194 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 249 195 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 250 196 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) 252 198 END DO 253 199 DO ji = 1, nn_hls ! last nn_hls points 254 200 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 255 201 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) 262 208 ! 263 209 ENDIF ! c_NFtype == 'T' … … 265 211 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 266 212 ! 267 SELECT CASE ( NAT_IN(jf))213 SELECT CASE ( cd_nat(jf) ) 268 214 CASE ( 'T' , 'W' ) ! T-, W-point 269 215 DO jl = 1, ipl; DO jk = 1, ipk … … 300 246 ii1 = ji ! ends at: nn_hls 301 247 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) 303 249 END DO 304 250 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 305 251 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 306 252 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) 308 254 END DO 309 255 DO ji = 1, nn_hls ! last nn_hls points 310 256 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 311 257 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) 313 259 END DO 314 260 END DO … … 326 272 ii1 = ji ! ends at: nn_hls-1 327 273 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) 329 275 END DO 330 276 DO ji = 1, 1 ! point nn_hls 331 277 ii1 = nn_hls + ji - 1 332 278 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) 334 280 END DO 335 281 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 336 282 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 337 283 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) 339 285 END DO 340 286 DO ji = 1, 1 ! point jpiglo - nn_hls 341 287 ii1 = jpiglo - nn_hls + ji - 1 342 288 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) 344 290 END DO 345 291 DO ji = 1, nn_hls ! last nn_hls points 346 292 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 347 293 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) 349 295 END DO 350 296 END DO … … 362 308 ii1 = ji ! ends at: nn_hls 363 309 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) 365 311 END DO 366 312 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 367 313 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 368 314 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) 370 316 END DO 371 317 DO ji = 1, nn_hls ! last nn_hls points 372 318 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 373 319 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) 375 321 END DO 376 322 END DO … … 384 330 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 385 331 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) 387 333 END DO 388 334 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) … … 390 336 ii1 = ji ! ends at: nn_hls 391 337 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) 393 339 END DO 394 340 ! ! last nn_hls points: have been / will done by e-w periodicity … … 407 353 ii1 = ji ! ends at: nn_hls-1 408 354 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) 410 356 END DO 411 357 DO ji = 1, 1 ! point nn_hls 412 358 ii1 = nn_hls + ji - 1 413 359 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) 415 361 END DO 416 362 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 417 363 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 418 364 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) 420 366 END DO 421 367 DO ji = 1, 1 ! point jpiglo - nn_hls 422 368 ii1 = jpiglo - nn_hls + ji - 1 423 369 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) 425 371 END DO 426 372 DO ji = 1, nn_hls ! last nn_hls points 427 373 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 428 374 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) 430 376 END DO 431 377 END DO … … 439 385 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 440 386 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) 442 388 END DO 443 389 DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done) … … 445 391 ii1 = ji ! ends at: nn_hls 446 392 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) 448 394 END DO 449 395 ! ! last nn_hls points: have been / will done by e-w periodicity … … 451 397 ! 452 398 END DO; END DO 453 END SELECT ! NAT_IN(jf)399 END SELECT ! cd_nat(jf) 454 400 ! 455 401 ENDIF ! c_NFtype == 'F' … … 457 403 END DO ! ipf 458 404 ! 459 END SUBROUTINE ROUTINE_NFD405 END SUBROUTINE lbc_nfd_/**/XD/**/_/**/PRECISION 460 406 461 #undef PRECISION 462 #undef ARRAY_TYPE 407 #undef XD 463 408 #undef ARRAY_IN 464 #undef NAT_IN465 #undef SGN_IN466 409 #undef J_SIZE 467 410 #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 ) 78 24 !!---------------------------------------------------------------------- 79 25 !! … … 82 28 !! 83 29 !!---------------------------------------------------------------------- 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 89 34 ! 90 INTEGER :: ji, jj, jk, jn, ii, jl, jh, jf! dummy loop indices91 INTEGER :: ip i, ipj, ipk, ipl, ipf, iij, ijj! dimension of the input array35 INTEGER :: ji, jj, jk, jn, jl, jh ! dummy loop indices 36 INTEGER :: ipk, ipl, ii, iij, ijj ! dimension of the input array 92 37 INTEGER :: ijt, iju, ijta, ijua, jia, startloop, endloop 93 38 LOGICAL :: l_fast_exchanges 94 39 !!---------------------------------------------------------------------- 95 ipj = J_SIZE(ptab2) ! 2nd dimension of input array96 40 ipk = K_SIZE(ptab) ! 3rd dimension of output array 97 41 ipl = L_SIZE(ptab) ! 4th - 98 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)99 42 ! 100 ! Security check for further developments101 IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' )102 43 ! 2nd dimension determines exchange speed 103 IF ( ipj== 1 ) THEN44 IF ( SIZE(ptab2,2) == 1 ) THEN 104 45 l_fast_exchanges = .TRUE. 105 46 ELSE 106 47 l_fast_exchanges = .FALSE. 107 48 ENDIF 108 !109 DO jf = 1, ipf ! Loop over the number of arrays to be processed110 49 ! 111 50 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 112 51 ! 113 SELECT CASE ( NAT_IN(jf))52 SELECT CASE ( cd_nat ) 114 53 ! 115 54 CASE ( 'T' , 'W' ) ! T-, W-point … … 123 62 DO ji = startloop, jpi 124 63 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) 126 65 END DO 127 66 END DO … … 132 71 ijj = jpj -jj +1 133 72 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) 135 74 END DO 136 75 END DO … … 153 92 ijta = jpiglo - jia + 2 154 93 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) 156 95 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) 158 97 ENDIF 159 98 END DO … … 172 111 DO ji = 1, endloop 173 112 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) 175 114 END DO 176 115 END DO … … 180 119 ijj = jpj -jj +1 181 120 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,:,:) 183 122 END DO 184 123 END DO … … 188 127 ijj = jpj -jj +1 189 128 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,:,:) 191 130 END DO 192 131 END DO … … 213 152 ijua = jpiglo - jia + 1 214 153 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) 216 155 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) 218 157 ENDIF 219 158 END DO … … 234 173 DO ji = startloop, jpi 235 174 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) 237 176 END DO 238 177 END DO … … 242 181 DO ji = startloop, jpi 243 182 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) 245 184 END DO 246 185 END DO; END DO … … 249 188 ijj = jpj-jj+1 250 189 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,:,:) 252 191 END DO 253 192 END DO … … 265 204 DO ji = 1, endloop 266 205 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) 268 207 END DO 269 208 END DO … … 273 212 DO ji = 1, endloop 274 213 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) 276 215 END DO 277 216 END DO; END DO 278 217 IF (nimpp .eq. 1) THEN 279 218 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,:,:) 281 220 END DO 282 221 IF ( .NOT. l_fast_exchanges ) THEN … … 284 223 ijj = jpj -jj 285 224 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,:,:) 287 226 END DO 288 227 END DO … … 291 230 IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 292 231 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,:,:) 294 233 END DO 295 234 IF ( .NOT. l_fast_exchanges ) THEN … … 297 236 ijj = jpj -jj 298 237 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,:,:) 300 239 END DO 301 240 END DO … … 309 248 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 310 249 ! 311 SELECT CASE ( NAT_IN(jf))250 SELECT CASE ( cd_nat ) 312 251 CASE ( 'T' , 'W' ) ! T-, W-point 313 252 DO jl = 1, ipl; DO jk = 1, ipk … … 316 255 DO ji = 1, jpi 317 256 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) 319 258 END DO 320 259 END DO … … 332 271 DO ji = 1, endloop 333 272 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) 335 274 END DO 336 275 END DO … … 342 281 DO ii = 1, nn_hls 343 282 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) 345 284 END DO 346 285 END DO … … 354 293 DO ji = 1, jpi 355 294 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) 357 296 END DO 358 297 END DO … … 371 310 DO ji = startloop, jpi 372 311 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) 374 313 END DO 375 314 END DO; END DO … … 388 327 DO ji = 1, endloop 389 328 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) 391 330 END DO 392 331 END DO … … 398 337 DO ii = 1, nn_hls 399 338 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) 401 340 END DO 402 341 END DO … … 421 360 DO ji = startloop, endloop 422 361 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) 424 363 END DO 425 364 END DO; END DO … … 431 370 ENDIF ! c_NFtype == 'F' 432 371 ! 433 END DO ! End jf loop434 END SUBROUTINE ROUTINE_NFD 435 #undef PRECISION436 #undef ARRAY_TYPE372 END SUBROUTINE lbc_nfd_nogather_/**/XD/**/_/**/PRECISION 373 374 #undef XD 375 #undef DIMS_IN 437 376 #undef ARRAY_IN 438 #undef NAT_IN439 #undef SGN_IN440 #undef J_SIZE441 377 #undef K_SIZE 442 378 #undef L_SIZE 443 #undef F_SIZE444 #undef ARRAY2_TYPE445 #undef ARRAY2_IN -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbclnk.F90
r14314 r14338 23 23 USE lbcnfd ! north fold 24 24 USE in_out_manager ! I/O manager 25 #if ! defined key_mpi_off 26 USE MPI 27 #endif 25 28 26 29 IMPLICIT NONE … … 28 31 29 32 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 48 45 END INTERFACE 49 46 ! … … 52 49 END INTERFACE 53 50 54 INTERFACE mpp_nfd55 MODULE PROCEDURE mpp_nfd_2d_sp , mpp_nfd_3d_sp , mpp_nfd_4d_sp56 MODULE PROCEDURE mpp_nfd_2d_dp , mpp_nfd_3d_dp , mpp_nfd_4d_dp57 MODULE PROCEDURE mpp_nfd_2d_ptr_sp, mpp_nfd_3d_ptr_sp, mpp_nfd_4d_ptr_sp58 MODULE PROCEDURE mpp_nfd_2d_ptr_dp, mpp_nfd_3d_ptr_dp, mpp_nfd_4d_ptr_dp59 60 END INTERFACE61 62 51 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 63 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions64 52 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_off69 !$AGRIF_DO_NOT_TREAT70 INCLUDE 'mpif.h'71 !$AGRIF_END_DO_NOT_TREAT72 #endif73 74 INTEGER, PUBLIC, PARAMETER :: jpfillnothing = 175 INTEGER, PUBLIC, PARAMETER :: jpfillcst = 276 INTEGER, PUBLIC, PARAMETER :: jpfillcopy = 377 INTEGER, PUBLIC, PARAMETER :: jpfillperio = 478 INTEGER, PUBLIC, PARAMETER :: jpfillmpi = 579 53 80 54 !! * Substitutions … … 88 62 89 63 !!---------------------------------------------------------------------- 90 !! *** l oad_ptr_(2,3,4)d***64 !! *** lbc_lnk_call_[234]d_[sd]p *** 91 65 !! 92 66 !! * 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) 94 69 !! cd_nat ! nature of pt2d array grid-points 95 70 !! psgn ! sign used across the north fold boundary … … 99 74 !! kfld ! number of elements that has been attributed 100 75 !!---------------------------------------------------------------------- 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 !!---------------------------------------------------------------------- 110 83 !! 111 84 !! ---- SINGLE PRECISION VERSIONS 112 85 !! 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 138 97 !! 139 98 !! ---- DOUBLE PRECISION VERSIONS 140 99 !! 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 171 119 !! cd_nat : nature of array grid-points 172 120 !! psgn : sign used across the north fold boundary 173 !! kfld : optional,number of pt3d arrays121 !! kfld : number of pt3d arrays 174 122 !! kfillmode : optional, method to be use to fill the halos (see jpfill* variables) 175 123 !! pfillval : optional, background value (used with jpfillcopy) 176 124 !!---------------------------------------------------------------------- 177 !178 ! !== 2D array and array of 2D pointer ==!179 !180 125 !! 181 126 !! ---- SINGLE PRECISION VERSIONS 182 127 !! 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 222 144 !! 223 145 !! ---- DOUBLE PRECISION VERSIONS 224 146 !! 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 503 163 504 164 !!====================================================================== -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbcnfd.F90
r13286 r14338 21 21 USE in_out_manager ! I/O manager 22 22 USE lib_mpp ! MPP library 23 #if ! defined key_mpi_off 24 USE MPI 25 #endif 23 26 24 27 IMPLICIT NONE 25 28 PRIVATE 26 29 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 45 33 END INTERFACE 46 34 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 56 39 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 68 46 PUBLIC lbc_nfd ! north fold conditions 69 47 PUBLIC lbc_nfd_nogather ! north fold conditions (no allgather case) … … 82 60 83 61 !!---------------------------------------------------------------------- 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 *** 85 65 !!---------------------------------------------------------------------- 86 66 !! … … 95 75 ! !== SINGLE PRECISION VERSIONS 96 76 ! 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 189 92 ! 190 93 ! !== DOUBLE PRECISION VERSIONS 191 94 ! 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 !!====================================================================== 192 112 ! 193 ! !== 2D array and array of 2D pointer ==!194 !195 # define DIM_2d196 # define ROUTINE_NFD lbc_nfd_2d_dp197 # include "lbc_nfd_generic.h90"198 # undef ROUTINE_NFD199 # define MULTI200 # define ROUTINE_NFD lbc_nfd_2d_ptr_dp201 # include "lbc_nfd_generic.h90"202 # undef ROUTINE_NFD203 # undef MULTI204 # undef DIM_2d205 !206 ! !== 2D array with extra haloes ==!207 !208 # define DIM_2d209 # define ROUTINE_NFD lbc_nfd_2d_ext_dp210 # include "lbc_nfd_ext_generic.h90"211 # undef ROUTINE_NFD212 # undef DIM_2d213 !214 ! !== 3D array and array of 3D pointer ==!215 !216 # define DIM_3d217 # define ROUTINE_NFD lbc_nfd_3d_dp218 # include "lbc_nfd_generic.h90"219 # undef ROUTINE_NFD220 # define MULTI221 # define ROUTINE_NFD lbc_nfd_3d_ptr_dp222 # include "lbc_nfd_generic.h90"223 # undef ROUTINE_NFD224 # undef MULTI225 # undef DIM_3d226 !227 ! !== 4D array and array of 4D pointer ==!228 !229 # define DIM_4d230 # define ROUTINE_NFD lbc_nfd_4d_dp231 # include "lbc_nfd_generic.h90"232 # undef ROUTINE_NFD233 # define MULTI234 # define ROUTINE_NFD lbc_nfd_4d_ptr_dp235 # include "lbc_nfd_generic.h90"236 # undef ROUTINE_NFD237 # undef MULTI238 # undef DIM_4d239 !240 ! lbc_nfd_nogather routines241 !242 ! !== 2D array and array of 2D pointer ==!243 !244 # define DIM_2d245 # define ROUTINE_NFD lbc_nfd_nogather_2d_dp246 # include "lbc_nfd_nogather_generic.h90"247 # undef ROUTINE_NFD248 # define MULTI249 # define ROUTINE_NFD lbc_nfd_nogather_2d_ptr_dp250 # include "lbc_nfd_nogather_generic.h90"251 # undef ROUTINE_NFD252 # undef MULTI253 # undef DIM_2d254 !255 ! !== 3D array and array of 3D pointer ==!256 !257 # define DIM_3d258 # define ROUTINE_NFD lbc_nfd_nogather_3d_dp259 # include "lbc_nfd_nogather_generic.h90"260 # undef ROUTINE_NFD261 # define MULTI262 # define ROUTINE_NFD lbc_nfd_nogather_3d_ptr_dp263 # include "lbc_nfd_nogather_generic.h90"264 # undef ROUTINE_NFD265 # undef MULTI266 # undef DIM_3d267 !268 ! !== 4D array and array of 4D pointer ==!269 !270 # define DIM_4d271 # define ROUTINE_NFD lbc_nfd_nogather_4d_dp272 # include "lbc_nfd_nogather_generic.h90"273 # undef ROUTINE_NFD274 !# define MULTI275 !# define ROUTINE_NFD lbc_nfd_nogather_4d_ptr276 !# include "lbc_nfd_nogather_generic.h90"277 !# undef ROUTINE_NFD278 !# undef MULTI279 # undef DIM_4d280 281 113 !!---------------------------------------------------------------------- 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 284 156 285 157 !!====================================================================== -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lib_mpp.F90
r14314 r14338 55 55 USE dom_oce ! ocean space and time domain 56 56 USE in_out_manager ! I/O manager 57 #if ! defined key_mpi_off 58 USE MPI 59 #endif 57 60 58 61 IMPLICIT NONE … … 107 110 END INTERFACE 108 111 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 109 132 !! ========================= !! 110 133 !! MPI variable definition !! 111 134 !! ========================= !! 112 135 #if ! defined key_mpi_off 113 !$AGRIF_DO_NOT_TREAT114 INCLUDE 'mpif.h'115 !$AGRIF_END_DO_NOT_TREAT116 136 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .TRUE. !: mpp flag 117 137 #else … … 199 219 200 220 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 201 228 202 229 !! * Substitutions … … 276 303 INTEGER , INTENT(in ) :: kdest ! receive process number 277 304 INTEGER , INTENT(in ) :: ktyp ! tag of the message 278 INTEGER , INTENT(in 305 INTEGER , INTENT(inout) :: md_req ! argument for isend 279 306 !! 280 307 INTEGER :: iflag … … 305 332 INTEGER , INTENT(in ) :: kdest ! receive process number 306 333 INTEGER , INTENT(in ) :: ktyp ! tag of the message 307 INTEGER , INTENT(in 334 INTEGER , INTENT(inout) :: md_req ! argument for isend 308 335 !! 309 336 INTEGER :: iflag … … 328 355 INTEGER , INTENT(in ) :: kdest ! receive process number 329 356 INTEGER , INTENT(in ) :: ktyp ! tag of the message 330 INTEGER , INTENT(in 357 INTEGER , INTENT(inout) :: md_req ! argument for isend 331 358 !! 332 359 INTEGER :: iflag … … 955 982 LOGICAL, OPTIONAL, INTENT(in) :: ld_abort ! source process number 956 983 LOGICAL :: ll_abort 957 INTEGER :: info 984 INTEGER :: info, ierr 958 985 !!---------------------------------------------------------------------- 959 986 ll_abort = .FALSE. … … 962 989 #if ! defined key_mpi_off 963 990 IF(ll_abort) THEN 964 CALL mpi_abort( MPI_COMM_WORLD )991 CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 965 992 ELSE 966 993 CALL mppsync … … 975 1002 SUBROUTINE mpp_comm_free( kcom ) 976 1003 !!---------------------------------------------------------------------- 977 INTEGER, INTENT(in ) :: kcom1004 INTEGER, INTENT(inout) :: kcom 978 1005 !! 979 1006 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 63 23 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 86 31 ! 87 32 LOGICAL :: ll_add_line … … 95 40 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 96 41 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 97 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather98 42 ! ! Workspace for message transfers avoiding mpi_allgather 99 43 INTEGER :: ipj_b ! sum of lines for all multi fields … … 103 47 INTEGER , DIMENSION(:) , ALLOCATABLE :: ipj_s ! number of sent lines 104 48 REAL(PRECISION), DIMENSION(:,:,:,:) , ALLOCATABLE :: ztabb, ztabr, ztabw ! buffer, receive and work arrays 105 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: z tabglo, znorthloc49 REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc 106 50 REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo 51 TYPE(PTR_4D_/**/PRECISION), DIMENSION(:), ALLOCATABLE :: ztabglo ! array or pointer of arrays on which apply the b.c. 107 52 !!---------------------------------------------------------------------- 108 53 ! … … 141 86 IF( ll_add_line ) THEN 142 87 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' /) ) 144 89 END DO 145 90 ELSE … … 156 101 ! 157 102 IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot 158 SELECT CASE ( NAT_IN(jf) )103 SELECT CASE ( cd_nat(jf) ) 159 104 CASE ( 'T', 'W', 'U' ) ; i012 = 1 ! T-, U-, W-point 160 105 CASE ( 'V', 'F' ) ; i012 = 2 ! V-, F-point … … 162 107 ENDIF 163 108 IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot 164 SELECT CASE ( NAT_IN(jf) )109 SELECT CASE ( cd_nat(jf) ) 165 110 CASE ( 'T', 'W', 'U' ) ; i012 = 0 ! T-, U-, W-point 166 111 CASE ( 'V', 'F' ) ; i012 = 1 ! V-, F-point … … 187 132 END DO 188 133 DO ji = jpi+1, jpimax 189 ztabb(ji,ij1,jk,jl) = HUGE VAL(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) 190 135 END DO 191 136 END DO … … 199 144 iproc = nfproc(isendto(jr)) 200 145 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 202 149 ENDIF 203 150 END DO … … 258 205 ELSE ! get data from a neighbour trough communication 259 206 ! 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 261 210 DO jl = 1, ipl ; DO jk = 1, ipk 262 211 DO jj = 1, ipj_b … … 278 227 ij1 = jj_b( 1 ,jf) 279 228 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) ) 281 230 END DO 282 231 ! … … 286 235 iproc = nfproc(isendto(jr)) 287 236 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 deallocate237 CALL mpi_wait( ml_req_nf(jr), MPI_STATUS_IGNORE, ml_err ) ! put the wait at the very end just before the deallocate 289 238 ENDIF 290 239 END DO … … 310 259 END DO 311 260 DO ji = Ni_0+1, i0max 312 znorthloc(ji,jj,jk,jl,jf) = HUGE VAL(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) 313 262 END DO 314 263 END DO … … 323 272 IF( ln_timing ) CALL tic_tac(.FALSE.) 324 273 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 326 278 ! 327 279 ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines … … 341 293 DO ji = 1, ipi 342 294 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 point295 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf) ! chose to take the 1st iner domain point 344 296 END DO 345 297 END DO … … 350 302 DO ji = 1, ipi 351 303 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc 352 ztabglo( ii1,jj,jk,jl,jf) = pfillval304 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval 353 305 END DO 354 306 END DO … … 362 314 DO ji = 1, ipi 363 315 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) 365 317 END DO 366 318 END DO … … 372 324 ! 373 325 DO jf = 1, ipf 374 CALL lbc_nfd( ztabglo( :,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG) ! North fold boundary condition326 CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), 1 ) ! North fold boundary condition 375 327 DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity 376 328 DO jj = 1, nn_hls + 1 377 329 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(j piglo-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) 380 332 END DO 381 333 END DO ; END DO … … 388 340 DO ji= 1, jpi 389 341 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) 391 343 END DO 392 344 END DO 393 345 END DO ; END DO ; END DO 394 346 ! 347 DO jf = 1, ipf 348 DEALLOCATE( ztabglo(jf)%pt4d ) 349 END DO 395 350 DEALLOCATE( ztabglo ) 396 351 ! 397 352 ENDIF ! l_north_nogather 398 353 ! 399 END SUBROUTINE ROUTINE_NFD354 END SUBROUTINE mpp_nfd_/**/XD/**/_/**/PRECISION 400 355 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 408 357 #undef ARRAY_IN 358 #undef ARRAY_LOCAL 409 359 #undef K_SIZE 410 360 #undef L_SIZE 411 361 #undef F_SIZE 412 #undef LBC_ARG413 #undef HUGEVAL -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mppini.F90
r14336 r14338 145 145 & cn_ice, nn_ice_dta, & 146 146 & 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 148 148 !!---------------------------------------------------------------------- 149 149 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfc1d_c2d.F90
r14189 r14338 95 95 END_3D 96 96 ! 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 ) 98 98 ! 99 99 CASE DEFAULT ! error -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfdyn.F90
r14201 r14338 412 412 ENDIF 413 413 ! 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 ) 415 415 ! 416 416 ! … … 444 444 END DO 445 445 ! 446 CALL lbc_lnk _multi( 'ldfdyn', dtensq, 'T', 1.0_wp ) ! lbc_lnk on dshesq not needed446 CALL lbc_lnk( 'ldfdyn', dtensq, 'T', 1.0_wp ) ! lbc_lnk on dshesq not needed 447 447 ! 448 448 DO jk = 1, jpkm1 … … 495 495 ENDIF 496 496 ! 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 ) 498 498 ! 499 499 END SELECT -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldfslp.F90
r14312 r14338 229 229 !!gm end modif 230 230 END_3D 231 CALL lbc_lnk _multi( 'ldfslp', zwz, 'U', -1.0_wp, zww, 'V', -1.0_wp ) ! lateral boundary conditions231 CALL lbc_lnk( 'ldfslp', zwz, 'U', -1.0_wp, zww, 'V', -1.0_wp ) ! lateral boundary conditions 232 232 ! 233 233 ! !* horizontal Shapiro filter … … 289 289 !!gm end modif 290 290 END_3D 291 CALL lbc_lnk _multi( 'ldfslp', zwz, 'T', -1.0_wp, zww, 'T', -1.0_wp ) ! lateral boundary conditions291 CALL lbc_lnk( 'ldfslp', zwz, 'T', -1.0_wp, zww, 'T', -1.0_wp ) ! lateral boundary conditions 292 292 ! 293 293 ! !* horizontal Shapiro filter … … 318 318 ! IV. Lateral boundary conditions 319 319 ! =============================== 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 ) 321 321 322 322 IF(sn_cfctl%l_prtctl) THEN … … 659 659 END_2D 660 660 !!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 ) 662 662 ! 663 663 END SUBROUTINE ldf_slp_mxl … … 727 727 ! END DO 728 728 ! 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. ) 730 730 !!gm ENDIF 731 731 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LDF/ldftra.F90
r14201 r14338 697 697 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) 698 698 END_2D 699 CALL lbc_lnk _multi( 'ldftra', paeiu(:,:,1), 'U', 1.0_wp , paeiv(:,:,1), 'V', 1.0_wp ) ! lateral boundary condition699 CALL lbc_lnk( 'ldftra', paeiu(:,:,1), 'U', 1.0_wp , paeiv(:,:,1), 'V', 1.0_wp ) ! lateral boundary condition 700 700 701 701 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/geo2ocean.F90
r14215 r14338 272 272 ! =========================== ! 273 273 ! ! 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, & 275 275 & gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp ) 276 276 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcblk.F90
r14072 r14338 830 830 831 831 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. ) 833 833 ELSE 834 CALL lbc_lnk _multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )834 CALL lbc_lnk( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 835 835 ENDIF 836 836 … … 1066 1066 pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) ) 1067 1067 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 ) 1069 1069 ! 1070 1070 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 1248 1248 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1249 1249 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 ) 1251 1251 ENDIF 1252 1252 llnewtx = .TRUE. … … 1666 1666 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1667 1667 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. ) 1669 1669 END SELECT 1670 1670 … … 2560 2560 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2561 2561 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 ) 2563 2563 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2564 2564 DO_2D( 0, 0, 0, 0 ) … … 2569 2569 END_2D 2570 2570 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 ) 2572 2572 ! 2573 2573 ENDIF … … 2637 2637 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2638 2638 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 ) 2640 2640 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2641 2641 DO_2D( 0, 0, 0, 0 ) … … 2646 2646 END_2D 2647 2647 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 ) 2649 2649 ! 2650 2650 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcflx.F90
r14072 r14338 145 145 ! 146 146 ! 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, & 148 148 & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp ) 149 149 ! … … 172 172 END_2D 173 173 ! 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 ) 175 175 ! 176 176 END SUBROUTINE sbc_flx -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcice_cice.F90
r14275 r14338 222 222 END_2D 223 223 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 ) 225 225 226 226 ! set the snow+ice mass … … 569 569 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 570 570 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 ) 572 572 573 573 ! Solar penetrative radiation and non solar surface heat flux … … 626 626 END_2D 627 627 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 ) 629 629 630 630 ! set the snow+ice mass -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcwave.F90
r14072 r14338 211 211 ENDIF 212 212 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 ) 214 214 215 215 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv.F90
r14189 r14338 182 182 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 183 183 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.) 186 186 #if defined key_loop_fusion 187 187 CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) … … 208 208 CASE ( np_QCK ) ! QUICKEST 209 209 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.) 211 211 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 212 212 END IF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_cen.F90
r14072 r14338 119 119 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 120 120 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. 122 122 ! 123 123 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 131 131 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v 132 132 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. ) 134 134 ! 135 135 CASE DEFAULT -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_fct.F90
r14298 r14338 238 238 END_2D 239 239 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) 241 241 ! 242 242 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) … … 247 247 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) 248 248 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) 250 250 ! 251 251 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested … … 256 256 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 257 257 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) 259 259 ! 260 260 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 268 268 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 269 269 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) 271 271 ! 272 272 END SELECT … … 292 292 ! 293 293 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 ) 295 295 ELSE 296 296 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) … … 449 449 END_2D 450 450 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) 452 452 453 453 ! 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 270 270 END_2D 271 271 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) 273 273 ! ! 274 274 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) … … 280 280 END_3D 281 281 ! 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) 283 283 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 284 284 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 298 298 zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk) 299 299 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) 301 301 ! 302 302 END SELECT -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_mus.F90
r14072 r14338 140 140 END_3D 141 141 ! 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 ) 143 143 ! !-- Slopes of tracer 144 144 zslpx(:,:,jpk) = 0._wp ! bottom values … … 176 176 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 177 177 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) 179 179 ! 180 180 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 149 149 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 150 150 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 conditions151 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 152 152 153 153 ! … … 167 167 END_3D 168 168 !--- 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 ) 170 170 171 171 !--- QUICKEST scheme … … 239 239 END_2D 240 240 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 conditions241 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 242 242 243 243 ! … … 259 259 260 260 !--- 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 ) 262 262 263 263 !--- QUICKEST scheme -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traadv_ubs.F90
r14072 r14338 140 140 ! 141 141 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) 143 143 ! 144 144 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 110 110 #endif 111 111 ! ! 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 ) 113 113 ! 114 114 IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries … … 156 156 ENDIF 157 157 ! 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 ) 159 159 160 160 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/traatf_qco.F90
r14072 r14338 146 146 ENDIF 147 147 ! 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 ) 149 149 ! 150 150 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/trabbl.F90
r14215 r14338 141 141 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 142 142 ! 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 ) 144 144 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport 145 145 CALL iom_put( "voce_bbl", vtr_bbl ) ! bbl j-transport … … 522 522 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 523 523 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) 525 525 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 526 526 ! … … 541 541 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 542 542 END_2D 543 CALL lbc_lnk _multi( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp ) ! lateral boundary conditions543 CALL lbc_lnk( 'trabbl', e3u_bbl_0, 'U', 1.0_wp , e3v_bbl_0, 'V', 1.0_wp ) ! lateral boundary conditions 544 544 ! 545 545 ! !* masked diffusive flux coefficients -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/tramle.F90
r14210 r14338 361 361 rfv(ji,jj) = SQRT( zfv * zfv + z1_t2 ) 362 362 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 ) 364 364 ! 365 365 ELSEIF( nn_mle == 1 ) THEN ! MLE array allocation & initialisation -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRA/trazdf.F90
r14189 r14338 102 102 END DO 103 103 !!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 ) 105 105 !!gm 106 106 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 173 173 END DO 174 174 ! 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. 176 176 ! 177 177 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 206 206 ENDIF 207 207 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 conditions208 IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 209 209 ! 210 210 END IF … … 359 359 END DO 360 360 ! 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. 362 362 363 363 ! horizontal derivative of density anomalies (rd) … … 401 401 END_2D 402 402 403 IF (nn_hls.EQ.1) CALL lbc_lnk _multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions403 IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 404 404 ! 405 405 END IF … … 452 452 ! 453 453 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. 455 455 456 456 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) … … 491 491 492 492 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 conditions493 IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 494 494 ! 495 495 END IF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trddyn.F90
r13497 r14338 128 128 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) ) 129 129 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 ) 131 131 CALL iom_put( "utrd_udx", z3dx ) 132 132 CALL iom_put( "vtrd_vdy", z3dy ) … … 164 164 ! END DO 165 165 ! 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 ) 167 167 ! CALL iom_put( "utrd_bfr", z3dx ) 168 168 ! CALL iom_put( "vtrd_bfr", z3dy ) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdken.F90
r13295 r14338 90 90 !!---------------------------------------------------------------------- 91 91 ! 92 CALL lbc_lnk _multi( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary conditions92 CALL lbc_lnk( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary conditions 93 93 ! 94 94 nkstp = kt -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdmxl.F90
r13497 r14338 154 154 !!gm to be put juste before the output ! 155 155 ! ! 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 ) 157 157 !!gm end 158 158 … … 472 472 !-- Lateral boundary conditions 473 473 ! ... 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, & 475 475 & ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, & 476 476 & ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp ) … … 523 523 !-- Lateral boundary conditions 524 524 ! ... 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, & 526 526 & ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp ) 527 527 ! 528 CALL lbc_lnk _multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! / in the NetCDF trends file528 CALL lbc_lnk( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! / in the NetCDF trends file 529 529 530 530 ! III.3 Time evolution array swap -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/TRD/trdvor.F90
r13497 r14338 162 162 163 163 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 condition164 CALL lbc_lnk( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) ! lateral boundary condition 165 165 166 166 … … 251 251 zvdpvor(:,:) = 0._wp 252 252 ! ! 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 ) 254 254 255 255 ! ===================================== … … 400 400 401 401 ! 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 ) 403 403 404 404 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/USR/usrdef_sbc.F90
r13295 r14338 181 181 wndm(ji,jj) = SQRT( zmod * zcoef ) 182 182 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 ) 184 184 185 185 ! ---------------------------------- ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfmfc.F90
r14072 r14338 376 376 ! 377 377 ! 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.) 379 379 ! 380 380 END SUBROUTINE tra_mfc -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfosm.F90
r14215 r14338 1163 1163 END_3D 1164 1164 ! 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, & 1166 1166 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 1167 1167 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) … … 1176 1176 END_3D 1177 1177 ! 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. ) 1179 1179 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1180 1180 ! 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, & 1182 1182 & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1183 1183 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ZDF/zdfphy.F90
r14072 r14338 323 323 ! !* Lateral boundary conditions (sign unchanged) 324 324 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, & 326 326 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 327 327 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 ) 329 329 ENDIF 330 330 ! 331 331 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 drag332 IF( ln_isfcav ) THEN ; CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp ) ! top & bot drag 333 333 ELSE ; CALL lbc_lnk ( 'zdfphy', rCdU_bot, 'T', 1.0_wp ) ! bottom drag only 334 334 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/stpmlf.F90
r14239 r14338 508 508 # endif 509 509 ! ! 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. & 511 511 & , pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 512 512 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/SWE/stpmlf.F90
r14319 r14338 197 197 ENDIF 198 198 199 CALL lbc_lnk _multi( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., & !* local domain boundaries199 CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., & !* local domain boundaries 200 200 & uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 201 201 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/SWE/stprk3.F90
r14319 r14338 171 171 ENDIF 172 172 ! 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. ) 174 174 ! 175 175 ! !== Swap time levels ==! … … 236 236 ENDIF 237 237 ! 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. ) 239 239 ! 240 240 ! !== Swap time levels ==! … … 299 299 ENDIF 300 300 ! 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. ) 302 302 ! 303 303 ! !== Swap time levels ==! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/PISCES/P2Z/p2zbio.F90
r13295 r14338 340 340 IF( lk_iomput ) THEN 341 341 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 ) 343 343 ! Save diagnostics 344 344 CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/TRP/trcadv.F90
r14086 r14338 131 131 CASE ( np_FCT ) ! FCT : 2nd / 4th order 132 132 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.) 135 135 #if defined key_loop_fusion 136 136 CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) … … 157 157 CASE ( np_QCK ) ! QUICKEST 158 158 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.) 160 160 CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 161 161 END IF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/TOP/TRP/trdmxl_trc.F90
r13497 r14338 419 419 !-- Lateral boundary conditions 420 420 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., & 422 422 & ztmlatf(:,:,jn) , 'T', 1. , ztmlrad(:,:,jn) , 'T', 1. ) 423 423 ENDIF … … 470 470 !-- Lateral boundary conditions 471 471 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. ) 473 473 DO jl = 1, jpltrd_trc 474 474 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 55 55 ! !!* nammpp namelist *!! 56 56 INTEGER :: jpni, jpnj 57 LOGICAL :: ln_ nnogather, ln_listonly57 LOGICAL :: ln_listonly 58 58 LOGICAL :: ln_Iperio, ln_Jperio 59 59 LOGICAL :: ln_NFold … … 61 61 !! 62 62 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 64 64 !!---------------------------------------------------------------------- 65 65 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/BENCH/MY_SRC/usrdef_sbc.F90
r14273 r14338 110 110 END_2D 111 111 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. ) 113 113 #endif 114 114 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/CANAL/MY_SRC/usrdef_istate.F90
r14224 r14338 239 239 ! 240 240 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. ) 242 242 243 243 END SUBROUTINE usr_def_istate -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/DOME/MY_SRC/usrdef_zgr.F90
r14336 r14338 98 98 END DO 99 99 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) 101 101 ! 102 102 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 354 354 355 355 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 ) 357 357 ! 358 358 ! !== Landfast ice parameterization ==! … … 492 492 zs2(ji,jj) = ( zs2(ji,jj) * zalph1 + zstressmtmp ) * z1_alph1 493 493 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) 495 495 496 496 ! Save beta at T-points for further computations … … 520 520 521 521 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 ) 523 523 524 524 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! … … 832 832 833 833 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, & 835 835 & zten_i, 'T', 1.0_wp, zs1 , 'T', 1.0_wp, zs2 , 'T', 1.0_wp, & 836 836 & zs12, 'F', 1.0_wp ) … … 849 849 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 850 850 ! 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, & 852 852 & ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 853 853 ! … … 934 934 IF( iom_use('yield11') .OR. iom_use('yield12') .OR. iom_use('yield22')) THEN 935 935 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 ) 937 937 938 938 CALL iom_put( 'yield11', zyield11 * aimsk00 ) … … 951 951 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 952 952 ! 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, & 954 954 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, & 955 955 & zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) … … 985 985 END_2D 986 986 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, & 988 988 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 989 989 & 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 320 320 321 321 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 ) 323 323 ! 324 324 ! !== Landfast ice parameterization ==! … … 770 770 771 771 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, & 773 773 & zs1 , 'T', 1._wp, zs2 , 'T', 1._wp, zs12 , 'F', 1._wp ) 774 774 … … 786 786 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 787 787 ! 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, & 789 789 & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 790 790 ! … … 871 871 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 872 872 ! 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, & 874 874 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 875 875 … … 904 904 END_2D 905 905 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, & 907 907 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 908 908 & 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 126 126 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.) 127 127 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. ) 129 129 130 130 wndm_ice(:,:) = 0._wp !!gm brutal.... … … 156 156 & * ( 0.5 * (windv(ji,jj+1) + windv(ji,jj) ) - r_vfac * v_ice(ji,jj) ) 157 157 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. ) 159 159 ! 160 160 END SUBROUTINE usrdef_sbc_ice_tau -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/STATION_ASF/MY_SRC/icesbc.F90
r14072 r14338 91 91 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 92 92 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 ) 94 94 ENDIF 95 95 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/SWG/MY_SRC/usrdef_sbc.F90
r13752 r14338 104 104 END DO 105 105 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. ) 107 107 ! 108 108 END SUBROUTINE usrdef_sbc_oce -
NEMO/branches/2021/dev_r14312_MPI_Interface/tests/VORTEX/MY_SRC/usrdef_istate.F90
r14133 r14338 123 123 END_2D 124 124 ! 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. ) 126 126 ! 127 127 END SUBROUTINE usr_def_istate
Note: See TracChangeset
for help on using the changeset viewer.