Changeset 10425 for NEMO/trunk/src/OCE/BDY
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/BDY
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdy_oce.F90
r10068 r10425 12 12 !!---------------------------------------------------------------------- 13 13 USE par_oce ! ocean parameters 14 USE lib_mpp ! distributed memory computing15 14 16 15 IMPLICIT NONE … … 148 147 FUNCTION bdy_oce_alloc() 149 148 !!---------------------------------------------------------------------- 150 USE lib_mpp, ONLY: ctl_ warn, mpp_sum149 USE lib_mpp, ONLY: ctl_stop, mpp_sum 151 150 ! 152 151 INTEGER :: bdy_oce_alloc … … 161 160 bdyvmask(:,:) = 1._wp 162 161 ! 163 IF( lk_mpp ) CALL mpp_sum (bdy_oce_alloc )164 IF( bdy_oce_alloc /= 0 ) CALL ctl_ warn('bdy_oce_alloc: failed to allocate arrays.')162 CALL mpp_sum ( 'bdy_oce', bdy_oce_alloc ) 163 IF( bdy_oce_alloc /= 0 ) CALL ctl_stop( 'STOP', 'bdy_oce_alloc: failed to allocate arrays.' ) 165 164 ! 166 165 END FUNCTION bdy_oce_alloc -
NEMO/trunk/src/OCE/BDY/bdydyn2d.F90
r10068 r10425 109 109 pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 110 110 END DO 111 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )112 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy) ! Boundary points should be updated111 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy ) 112 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy) ! Boundary points should be updated 113 113 ! 114 114 END SUBROUTINE bdy_dyn2d_frs … … 169 169 END DO 170 170 171 CALL lbc_bdy_lnk( spgu(:,:), 'T', 1., ib_bdy )171 CALL lbc_bdy_lnk( 'bdydyn2d', spgu(:,:), 'T', 1., ib_bdy ) 172 172 ! 173 173 igrd = 2 ! Flather bc on u-velocity; … … 207 207 pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 208 208 END DO 209 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated210 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy ) !209 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated 210 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy ) ! 211 211 ! 212 212 END SUBROUTINE bdy_dyn2d_fla … … 243 243 CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 244 244 ! 245 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated246 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy ) !245 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated 246 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy ) ! 247 247 ! 248 248 END SUBROUTINE bdy_dyn2d_orlanski … … 291 291 292 292 ! Boundary points should be updated 293 CALL lbc_bdy_lnk( zssh(:,:), 'T', 1., ib_bdy )293 CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:), 'T', 1., ib_bdy ) 294 294 END DO 295 295 -
NEMO/trunk/src/OCE/BDY/bdydyn3d.F90
r10068 r10425 97 97 END DO 98 98 END DO 99 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated100 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )99 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 100 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 101 101 ! 102 102 IF( kt == nit000 ) CLOSE( unit = 102 ) … … 144 144 END DO 145 145 END DO 146 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated147 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )146 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 147 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 148 148 ! 149 149 IF( kt == nit000 ) CLOSE( unit = 102 ) … … 187 187 END DO 188 188 ! 189 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk(va, 'V', -1.,ib_bdy ) ! Boundary points should be updated189 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 190 190 ! 191 191 IF( kt == nit000 ) CLOSE( unit = 102 ) … … 234 234 END DO 235 235 END DO 236 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated237 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )236 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 237 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 238 238 ! 239 239 IF( kt == nit000 ) CLOSE( unit = 102 ) … … 270 270 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 271 271 ! 272 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated273 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )272 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 273 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 274 274 ! 275 275 END SUBROUTINE bdy_dyn3d_orlanski … … 319 319 END DO 320 320 ! 321 CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. ) ! Boundary points should be updated321 CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1., va, 'V', -1. ) ! Boundary points should be updated 322 322 ! 323 323 IF( ln_timing ) CALL timing_stop('bdy_dyn3d_dmp') … … 351 351 CALL bdy_nmn( idx, igrd, va ) 352 352 ! 353 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated354 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )353 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 354 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 355 355 ! 356 356 END SUBROUTINE bdy_dyn3d_nmn -
NEMO/trunk/src/OCE/BDY/bdyice.F90
r10069 r10425 135 135 ENDDO 136 136 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy )138 CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy )139 CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy )137 CALL lbc_bdy_lnk( 'bdyice', a_i(:,:,:), 'T', 1., jbdy ) 138 CALL lbc_bdy_lnk( 'bdyice', h_i(:,:,:), 'T', 1., jbdy ) 139 CALL lbc_bdy_lnk( 'bdyice', h_s(:,:,:), 'T', 1., jbdy ) 140 140 141 141 DO jl = 1, jpl … … 244 244 END DO ! jl 245 245 246 CALL lbc_bdy_lnk( a_i (:,:,:) , 'T', 1., jbdy )247 CALL lbc_bdy_lnk( h_i (:,:,:) , 'T', 1., jbdy )248 CALL lbc_bdy_lnk( h_s (:,:,:) , 'T', 1., jbdy )249 CALL lbc_bdy_lnk( oa_i(:,:,:) , 'T', 1., jbdy )250 CALL lbc_bdy_lnk( a_ip(:,:,:) , 'T', 1., jbdy )251 CALL lbc_bdy_lnk( v_ip(:,:,:) , 'T', 1., jbdy )252 CALL lbc_bdy_lnk( s_i (:,:,:) , 'T', 1., jbdy )253 CALL lbc_bdy_lnk( t_su(:,:,:) , 'T', 1., jbdy )254 CALL lbc_bdy_lnk( v_i (:,:,:) , 'T', 1., jbdy )255 CALL lbc_bdy_lnk( v_s (:,:,:) , 'T', 1., jbdy )256 CALL lbc_bdy_lnk( sv_i(:,:,:) , 'T', 1., jbdy )257 CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy )258 CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy )259 CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy )260 CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy )246 CALL lbc_bdy_lnk( 'bdyice', a_i (:,:,:) , 'T', 1., jbdy ) 247 CALL lbc_bdy_lnk( 'bdyice', h_i (:,:,:) , 'T', 1., jbdy ) 248 CALL lbc_bdy_lnk( 'bdyice', h_s (:,:,:) , 'T', 1., jbdy ) 249 CALL lbc_bdy_lnk( 'bdyice', oa_i(:,:,:) , 'T', 1., jbdy ) 250 CALL lbc_bdy_lnk( 'bdyice', a_ip(:,:,:) , 'T', 1., jbdy ) 251 CALL lbc_bdy_lnk( 'bdyice', v_ip(:,:,:) , 'T', 1., jbdy ) 252 CALL lbc_bdy_lnk( 'bdyice', s_i (:,:,:) , 'T', 1., jbdy ) 253 CALL lbc_bdy_lnk( 'bdyice', t_su(:,:,:) , 'T', 1., jbdy ) 254 CALL lbc_bdy_lnk( 'bdyice', v_i (:,:,:) , 'T', 1., jbdy ) 255 CALL lbc_bdy_lnk( 'bdyice', v_s (:,:,:) , 'T', 1., jbdy ) 256 CALL lbc_bdy_lnk( 'bdyice', sv_i(:,:,:) , 'T', 1., jbdy ) 257 CALL lbc_bdy_lnk( 'bdyice', t_s (:,:,:,:), 'T', 1., jbdy ) 258 CALL lbc_bdy_lnk( 'bdyice', e_s (:,:,:,:), 'T', 1., jbdy ) 259 CALL lbc_bdy_lnk( 'bdyice', t_i (:,:,:,:), 'T', 1., jbdy ) 260 CALL lbc_bdy_lnk( 'bdyice', e_i (:,:,:,:), 'T', 1., jbdy ) 261 261 ! 262 262 END SUBROUTINE bdy_ice_frs … … 317 317 ! 318 318 END DO 319 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy )319 CALL lbc_bdy_lnk( 'bdyice', u_ice(:,:), 'U', -1., jbdy ) 320 320 ! 321 321 CASE ( 'V' ) … … 340 340 ! 341 341 END DO 342 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy )342 CALL lbc_bdy_lnk( 'bdyice', v_ice(:,:), 'V', -1., jbdy ) 343 343 ! 344 344 END SELECT -
NEMO/trunk/src/OCE/BDY/bdyini.F90
r10068 r10425 1133 1133 END DO 1134 1134 END DO 1135 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond.1135 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond. 1136 1136 1137 1137 ! bdy masks are now set to zero on boundary points: … … 1169 1169 1170 1170 ! Lateral boundary conditions 1171 CALL lbc_lnk( zfmask, 'F', 1. )1172 CALL lbc_lnk_multi( bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. )1171 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 1172 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 1173 1173 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1174 1174 … … 1203 1203 END DO 1204 1204 IF( icount /= 0 ) THEN 1205 IF(lwp) WRITE(numout,*) 1206 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1205 WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1207 1206 ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1208 IF(lwp) WRITE(numout,*) ' ========== ' 1209 IF(lwp) WRITE(numout,*) 1210 nstop = nstop + 1 1207 WRITE(ctmp2,*) ' ========== ' 1208 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1211 1209 ENDIF 1212 1210 END DO … … 1238 1236 END DO 1239 1237 IF( icount /= 0 ) THEN 1240 IF(lwp) WRITE(numout,*) 1241 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1238 WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1242 1239 ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1243 IF(lwp) WRITE(numout,*) ' ========== ' 1244 IF(lwp) WRITE(numout,*) 1245 nstop = nstop + 1 1240 WRITE(ctmp2,*) ' ========== ' 1241 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1246 1242 ENDIF 1247 1243 END DO … … 1280 1276 END DO 1281 1277 ! 1282 IF( lk_mpp ) CALL mpp_sum(bdysurftot ) ! sum over the global domain1278 CALL mpp_sum( 'bdyini', bdysurftot ) ! sum over the global domain 1283 1279 END IF 1284 1280 ! … … 1376 1372 icorns(ib2,1) = npckgw(ib1) 1377 1373 ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN 1378 IF(lwp) WRITE(numout,*) 1379 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1380 & jpisft(ib2), jpjwft(ib1) 1381 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1382 IF(lwp) WRITE(numout,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1383 & ' and South segment: ',npckgs(ib2) 1384 IF(lwp) WRITE(numout,*) 1385 nstop = nstop + 1 1374 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1375 & jpisft(ib2), jpjwft(ib1) 1376 WRITE(ctmp2,*) ' ========== Not allowed yet' 1377 WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1378 & ' and South segment: ',npckgs(ib2) 1379 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1386 1380 ELSE 1387 IF(lwp) WRITE(numout,*) 1388 IF(lwp) WRITE(numout,*) ' E R R O R : Check South and West Open boundary indices' 1389 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with West segment: ',npckgw(ib1) , & 1390 & ' and South segment: ',npckgs(ib2) 1391 IF(lwp) WRITE(numout,*) 1392 nstop = nstop+1 1381 WRITE(ctmp1,*) ' E R R O R : Check South and West Open boundary indices' 1382 WRITE(ctmp2,*) ' ========== Crossing problem with West segment: ',npckgw(ib1) , & 1383 & ' and South segment: ',npckgs(ib2) 1384 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1393 1385 END IF 1394 1386 END IF … … 1412 1404 icorns(ib2,2) = npckge(ib1) 1413 1405 ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN 1414 IF(lwp) WRITE(numout,*) 1415 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1416 & jpisdt(ib2), jpjeft(ib1) 1417 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1418 IF(lwp) WRITE(numout,*) ' Crossing problem with East segment: ',npckge(ib1), & 1419 & ' and South segment: ',npckgs(ib2) 1420 IF(lwp) WRITE(numout,*) 1421 nstop = nstop + 1 1406 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1407 & jpisdt(ib2), jpjeft(ib1) 1408 WRITE(ctmp2,*) ' ========== Not allowed yet' 1409 WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 1410 & ' and South segment: ',npckgs(ib2) 1411 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1422 1412 ELSE 1423 IF(lwp) WRITE(numout,*) 1424 IF(lwp) WRITE(numout,*) ' E R R O R : Check South and East Open boundary indices' 1425 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1426 & ' and South segment: ',npckgs(ib2) 1427 IF(lwp) WRITE(numout,*) 1428 nstop = nstop + 1 1413 WRITE(ctmp1,*) ' E R R O R : Check South and East Open boundary indices' 1414 WRITE(ctmp2,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1415 & ' and South segment: ',npckgs(ib2) 1416 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1429 1417 END IF 1430 1418 END IF … … 1448 1436 icornn(ib2,1) = npckgw(ib1) 1449 1437 ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN 1450 IF(lwp) WRITE(numout,*) 1451 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1438 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1452 1439 & jpinft(ib2), jpjwdt(ib1) 1453 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet'1454 IF(lwp) WRITE(numout,*) ' Crossing problem with West segment: ',npckgw(ib1), &1440 WRITE(ctmp2,*) ' ========== Not allowed yet' 1441 WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), & 1455 1442 & ' and North segment: ',npckgn(ib2) 1456 IF(lwp) WRITE(numout,*) 1457 nstop = nstop + 1 1443 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1458 1444 ELSE 1459 IF(lwp) WRITE(numout,*) 1460 IF(lwp) WRITE(numout,*) ' E R R O R : Check North and West Open boundary indices' 1461 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with West segment: ',npckgw(ib1), & 1445 WRITE(ctmp1,*) ' E R R O R : Check North and West Open boundary indices' 1446 WRITE(ctmp2,*) ' ========== Crossing problem with West segment: ',npckgw(ib1), & 1462 1447 & ' and North segment: ',npckgn(ib2) 1463 IF(lwp) WRITE(numout,*) 1464 nstop = nstop + 1 1448 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1465 1449 END IF 1466 1450 END IF … … 1484 1468 icornn(ib2,2) = npckge(ib1) 1485 1469 ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN 1486 IF(lwp) WRITE(numout,*) 1487 IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1470 WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 1488 1471 & jpindt(ib2), jpjedt(ib1) 1489 IF(lwp) WRITE(numout,*) ' ========== Not allowed yet' 1490 IF(lwp) WRITE(numout,*) ' Crossing problem with East segment: ',npckge(ib1), & 1491 & ' and North segment: ',npckgn(ib2) 1492 IF(lwp) WRITE(numout,*) 1493 nstop = nstop + 1 1472 WRITE(ctmp2,*) ' ========== Not allowed yet' 1473 WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 1474 & ' and North segment: ',npckgn(ib2) 1475 CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 1494 1476 ELSE 1495 IF(lwp) WRITE(numout,*) 1496 IF(lwp) WRITE(numout,*) ' E R R O R : Check North and East Open boundary indices' 1497 IF(lwp) WRITE(numout,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1498 & ' and North segment: ',npckgn(ib2) 1499 IF(lwp) WRITE(numout,*) 1500 nstop = nstop + 1 1477 WRITE(ctmp1,*) ' E R R O R : Check North and East Open boundary indices' 1478 WRITE(ctmp2,*) ' ========== Crossing problem with East segment: ',npckge(ib1), & 1479 & ' and North segment: ',npckgn(ib2) 1480 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1501 1481 END IF 1502 1482 END IF … … 1520 1500 END DO 1521 1501 END DO 1522 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1502 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1523 1503 1524 1504 IF (ztestmask(1)==1) THEN 1525 1505 IF (icornw(ib,1)==0) THEN 1526 IF(lwp) WRITE(numout,*) 1527 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1528 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1529 IF(lwp) WRITE(numout,*) 1530 nstop = nstop + 1 1506 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1507 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1508 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1531 1509 ELSE 1532 1510 ! This is a corner … … 1538 1516 IF (ztestmask(2)==1) THEN 1539 1517 IF (icornw(ib,2)==0) THEN 1540 IF(lwp) WRITE(numout,*) 1541 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1542 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1543 IF(lwp) WRITE(numout,*) 1544 nstop = nstop + 1 1518 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 1519 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1520 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1545 1521 ELSE 1546 1522 ! This is a corner … … 1564 1540 END DO 1565 1541 END DO 1566 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1542 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1567 1543 1568 1544 IF (ztestmask(1)==1) THEN 1569 1545 IF (icorne(ib,1)==0) THEN 1570 IF(lwp) WRITE(numout,*) 1571 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib) 1572 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1573 IF(lwp) WRITE(numout,*) 1574 nstop = nstop + 1 1546 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 1547 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1548 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1575 1549 ELSE 1576 1550 ! This is a corner … … 1582 1556 IF (ztestmask(2)==1) THEN 1583 1557 IF (icorne(ib,2)==0) THEN 1584 IF(lwp) WRITE(numout,*) 1585 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib) 1586 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1587 IF(lwp) WRITE(numout,*) 1588 nstop = nstop + 1 1558 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 1559 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1560 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1589 1561 ELSE 1590 1562 ! This is a corner … … 1608 1580 END DO 1609 1581 END DO 1610 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1582 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1611 1583 1612 1584 IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN 1613 IF(lwp) WRITE(numout,*) 1614 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1615 IF(lwp) WRITE(numout,*) ' ========== does not start on land or on a corner' 1616 IF(lwp) WRITE(numout,*) 1617 nstop = nstop + 1 1585 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1586 WRITE(ctmp2,*) ' ========== does not start on land or on a corner' 1587 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1618 1588 ENDIF 1619 1589 IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN 1620 IF(lwp) WRITE(numout,*) 1621 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1622 IF(lwp) WRITE(numout,*) ' ========== does not end on land or on a corner' 1623 IF(lwp) WRITE(numout,*) 1624 nstop = nstop + 1 1590 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 1591 WRITE(ctmp2,*) ' ========== does not end on land or on a corner' 1592 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1625 1593 ENDIF 1626 1594 END DO … … 1638 1606 END DO 1639 1607 END DO 1640 IF( lk_mpp ) CALL mpp_sum(ztestmask, 2 ) ! sum over the global domain1608 CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain 1641 1609 1642 1610 IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN 1643 IF(lwp) WRITE(numout,*) 1644 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1645 IF(lwp) WRITE(numout,*) ' ========== does not start on land' 1646 IF(lwp) WRITE(numout,*) 1647 nstop = nstop + 1 1611 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1612 WRITE(ctmp2,*) ' ========== does not start on land' 1613 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1648 1614 ENDIF 1649 1615 IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN 1650 IF(lwp) WRITE(numout,*) 1651 IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1652 IF(lwp) WRITE(numout,*) ' ========== does not end on land' 1653 IF(lwp) WRITE(numout,*) 1654 nstop = nstop + 1 1616 WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 1617 WRITE(ctmp2,*) ' ========== does not end on land' 1618 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1655 1619 ENDIF 1656 1620 END DO … … 1691 1655 ! 1692 1656 IF( itest>0 ) THEN 1693 IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1694 IF(lwp) WRITE(numout,*) ' ========== have different open bdy schemes' 1695 IF(lwp) WRITE(numout,*) 1696 nstop = nstop + 1 1657 WRITE(ctmp1,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1658 WRITE(ctmp2,*) ' ========== have different open bdy schemes' 1659 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1697 1660 ENDIF 1698 1661 ! -
NEMO/trunk/src/OCE/BDY/bdytra.F90
r10068 r10425 71 71 END SELECT 72 72 ! Boundary points should be updated 73 CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy )73 CALL lbc_bdy_lnk( 'bdytra', tsa(:,:,:,jn), 'T', 1., ib_bdy ) 74 74 ! 75 75 END DO -
NEMO/trunk/src/OCE/BDY/bdyvol.F90
r10068 r10425 85 85 !!gm replace these lines : 86 86 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 87 IF( lk_mpp ) CALL mpp_sum(z_cflxemp ) ! sum over the global domain87 CALL mpp_sum( 'bdyvol', z_cflxemp ) ! sum over the global domain 88 88 !!gm by : 89 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau089 !!gm z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 90 90 !!gm 91 91 … … 114 114 ! 115 115 END DO 116 IF( lk_mpp ) CALL mpp_sum(zubtpecor ) ! sum over the global domain116 CALL mpp_sum( 'bdyvol', zubtpecor ) ! sum over the global domain 117 117 118 118 ! The normal velocity correction … … 148 148 ! 149 149 END DO 150 IF( lk_mpp ) CALL mpp_sum(ztranst ) ! sum over the global domain150 CALL mpp_sum( 'bdyvol', ztranst ) ! sum over the global domain 151 151 152 152 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
Note: See TracChangeset
for help on using the changeset viewer.