- Timestamp:
- 2020-09-15T12:49:18+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/temporary_r4_trunk/src/OCE/SBC/sbccpl.F90
r13467 r13469 1193 1193 ! 1194 1194 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1195 DO jj = 2, jpjm1 ! T ==> (U,V) 1196 DO ji = fs_2, fs_jpim1 ! vector opt. 1197 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1198 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1199 END DO 1200 END DO 1195 DO_2D_00_00 1196 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1197 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1198 END_2D 1201 1199 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1., frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 1202 1200 ENDIF … … 1219 1217 ! => need to be done only when otx1 was changed 1220 1218 IF( llnewtx ) THEN 1221 DO jj = 2, jpjm1 1222 DO ji = fs_2, fs_jpim1 ! vect. opt. 1223 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1224 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1225 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1226 END DO 1227 END DO 1219 DO_2D_00_00 1220 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1221 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1222 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1223 END_2D 1228 1224 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 1229 1225 llnewtau = .TRUE. … … 1246 1242 IF( llnewtau ) THEN 1247 1243 zcoef = 1. / ( zrhoa * zcdrag ) 1248 DO jj = 1, jpj 1249 DO ji = 1, jpi 1250 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1251 END DO 1252 END DO 1244 DO_2D_11_11 1245 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1246 END_2D 1253 1247 ENDIF 1254 1248 ENDIF … … 1389 1383 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1390 1384 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1391 u b (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau1392 u n (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling1385 uu (:,:,1,Nnn) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1386 uu (:,:,1,Nii) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1393 1387 CALL iom_put( 'ssu_m', ssu_m ) 1394 1388 ENDIF 1395 1389 IF( srcv(jpr_ocy1)%laction ) THEN 1396 1390 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1397 v b (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau1398 v n (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling1391 vv (:,:,1,Nnn) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1392 vv (:,:,1,Nii) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1399 1393 CALL iom_put( 'ssv_m', ssv_m ) 1400 1394 ENDIF … … 1586 1580 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1587 1581 CASE( 'T' ) 1588 DO jj = 2, jpjm1 ! T ==> (U,V) 1589 DO ji = fs_2, fs_jpim1 ! vector opt. 1590 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1591 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1592 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1593 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1594 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1595 END DO 1596 END DO 1582 DO_2D_00_00 1583 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1584 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1585 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1586 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1587 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1588 END_2D 1597 1589 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1598 1590 END SELECT … … 2466 2458 ! i i+1 (for I) 2467 2459 IF( nn_components == jp_iam_opa ) THEN 2468 zotx1(:,:) = u n(:,:,1)2469 zoty1(:,:) = v n(:,:,1)2460 zotx1(:,:) = uu(:,:,1,Nii) 2461 zoty1(:,:) = vv(:,:,1,Nii) 2470 2462 ELSE 2471 2463 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2472 2464 CASE( 'oce only' ) ! C-grid ==> T 2473 DO jj = 2, jpjm1 2474 DO ji = fs_2, fs_jpim1 ! vector opt. 2475 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2476 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2477 END DO 2478 END DO 2465 DO_2D_00_00 2466 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj ,1,Nii) ) 2467 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji ,jj-1,1,Nii) ) 2468 END_2D 2479 2469 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2480 DO jj = 2, jpjm1 2481 DO ji = fs_2, fs_jpim1 ! vector opt. 2482 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2483 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2484 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2485 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2486 END DO 2487 END DO 2470 DO_2D_00_00 2471 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Nii) + uu (ji-1,jj ,1,Nii) ) * zfr_l(ji,jj) 2472 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Nii) + vv (ji ,jj-1,1,Nii) ) * zfr_l(ji,jj) 2473 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2474 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2475 END_2D 2488 2476 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2489 2477 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2490 DO jj = 2, jpjm1 2491 DO ji = fs_2, fs_jpim1 ! vector opt. 2492 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2493 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2494 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2495 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2496 END DO 2497 END DO 2478 DO_2D_00_00 2479 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Nii) + uu (ji-1,jj ,1,Nii) ) * zfr_l(ji,jj) & 2480 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2481 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Nii) + vv (ji ,jj-1,1,Nii) ) * zfr_l(ji,jj) & 2482 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2483 END_2D 2498 2484 END SELECT 2499 2485 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1., zoty1, ssnd(jps_ocy1)%clgrid, -1. ) … … 2554 2540 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2555 2541 CASE( 'oce only' ) ! C-grid ==> T 2556 DO jj = 2, jpjm1 2557 DO ji = fs_2, fs_jpim1 ! vector opt. 2558 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2559 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) ) 2560 END DO 2561 END DO 2542 DO_2D_00_00 2543 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Nii) + uu(ji-1,jj ,1,Nii) ) 2544 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Nii) + vv(ji , jj-1,1,Nii) ) 2545 END_2D 2562 2546 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2563 DO jj = 2, jpjm1 2564 DO ji = fs_2, fs_jpim1 ! vector opt. 2565 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 2566 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 2567 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2568 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2569 END DO 2570 END DO 2547 DO_2D_00_00 2548 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Nii) + uu (ji-1,jj ,1,Nii) ) * zfr_l(ji,jj) 2549 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Nii) + vv (ji ,jj-1,1,Nii) ) * zfr_l(ji,jj) 2550 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2551 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2552 END_2D 2571 2553 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1., zity1, 'T', -1. ) 2572 2554 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2573 DO jj = 2, jpjm1 2574 DO ji = fs_2, fs_jpim1 ! vector opt. 2575 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 2576 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2577 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 2578 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2579 END DO 2580 END DO 2555 DO_2D_00_00 2556 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Nii) + uu (ji-1,jj ,1,Nii) ) * zfr_l(ji,jj) & 2557 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2558 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Nii) + vv (ji ,jj-1,1,Nii) ) * zfr_l(ji,jj) & 2559 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2560 END_2D 2581 2561 END SELECT 2582 2562 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1., zoty1, ssnd(jps_ocyw)%clgrid, -1. )
Note: See TracChangeset
for help on using the changeset viewer.
