- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/SBC/sbccpl.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90
r11536 r11949 32 32 USE cpl_oasis3 ! OASIS3 coupling 33 33 USE geo2ocean ! 34 USE oce , ONLY : ts n, un, vn, sshn, ub, vb, sshb, fraqsr_1lev34 USE oce , ONLY : ts, uu, vv, ssh, fraqsr_1lev 35 35 USE ocealb ! 36 36 USE eosbn2 ! … … 1049 1049 1050 1050 1051 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1051 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 1052 1052 !!---------------------------------------------------------------------- 1053 1053 !! *** ROUTINE sbc_cpl_rcv *** … … 1099 1099 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 1100 1100 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 1101 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level indices 1101 1102 !! 1102 1103 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 1302 1303 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1303 1304 .OR. srcv(jpr_hsig)%laction .OR. srcv(jpr_wfreq)%laction) THEN 1304 CALL sbc_stokes( )1305 CALL sbc_stokes( Kmm ) 1305 1306 ENDIF 1306 1307 ENDIF … … 1354 1355 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1355 1356 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1356 u b (:,:,1) = ssu_m(:,:)! will be used in icestp in the call of ice_forcing_tau1357 u n (:,:,1) = ssu_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1357 uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1358 uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1358 1359 CALL iom_put( 'ssu_m', ssu_m ) 1359 1360 ENDIF 1360 1361 IF( srcv(jpr_ocy1)%laction ) THEN 1361 1362 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1362 v b (:,:,1) = ssv_m(:,:)! will be used in icestp in the call of ice_forcing_tau1363 v n (:,:,1) = ssv_m(:,:)! will be used in sbc_cpl_snd if atmosphere coupling1363 vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1364 vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1364 1365 CALL iom_put( 'ssv_m', ssv_m ) 1365 1366 ENDIF … … 2036 2037 2037 2038 2038 SUBROUTINE sbc_cpl_snd( kt )2039 SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 2039 2040 !!---------------------------------------------------------------------- 2040 2041 !! *** ROUTINE sbc_cpl_snd *** … … 2046 2047 !!---------------------------------------------------------------------- 2047 2048 INTEGER, INTENT(in) :: kt 2049 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean model time level index 2048 2050 ! 2049 2051 INTEGER :: ji, jj, jl ! dummy loop indices … … 2063 2065 2064 2066 IF ( nn_components == jp_iam_opa ) THEN 2065 ztmp1(:,:) = ts n(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part2067 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2066 2068 ELSE 2067 2069 ! we must send the surface potential temperature 2068 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts n(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )2069 ELSE ; ztmp1(:,:) = ts n(:,:,1,jp_tem)2070 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 2071 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 2070 2072 ENDIF 2071 2073 ! … … 2095 2097 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2096 2098 END SELECT 2097 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts n(:,:,1,jp_tem) + rt02099 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 2098 2100 SELECT CASE( sn_snd_temp%clcat ) 2099 2101 CASE( 'yes' ) … … 2316 2318 ! i i+1 (for I) 2317 2319 IF( nn_components == jp_iam_opa ) THEN 2318 zotx1(:,:) = u n(:,:,1)2319 zoty1(:,:) = v n(:,:,1)2320 zotx1(:,:) = uu(:,:,1,Kmm) 2321 zoty1(:,:) = vv(:,:,1,Kmm) 2320 2322 ELSE 2321 2323 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) … … 2323 2325 DO jj = 2, jpjm1 2324 2326 DO ji = fs_2, fs_jpim1 ! vector opt. 2325 zotx1(ji,jj) = 0.5 * ( u n(ji,jj,1) + un(ji-1,jj ,1) )2326 zoty1(ji,jj) = 0.5 * ( v n(ji,jj,1) + vn(ji ,jj-1,1) )2327 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2328 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2327 2329 END DO 2328 2330 END DO … … 2330 2332 DO jj = 2, jpjm1 2331 2333 DO ji = fs_2, fs_jpim1 ! vector opt. 2332 zotx1(ji,jj) = 0.5 * ( u n (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)2333 zoty1(ji,jj) = 0.5 * ( v n (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)2334 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj )) * fr_i(ji,jj)2335 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 )) * fr_i(ji,jj)2334 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2335 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2336 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2337 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2336 2338 END DO 2337 2339 END DO … … 2340 2342 DO jj = 2, jpjm1 2341 2343 DO ji = fs_2, fs_jpim1 ! vector opt. 2342 zotx1(ji,jj) = 0.5 * ( u n (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &2343 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj )) * fr_i(ji,jj)2344 zoty1(ji,jj) = 0.5 * ( v n (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &2345 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 )) * fr_i(ji,jj)2344 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2345 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2346 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2347 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2346 2348 END DO 2347 2349 END DO … … 2406 2408 DO jj = 2, jpjm1 2407 2409 DO ji = fs_2, fs_jpim1 ! vector opt. 2408 zotx1(ji,jj) = 0.5 * ( u n(ji,jj,1) + un(ji-1,jj ,1) )2409 zoty1(ji,jj) = 0.5 * ( v n(ji,jj,1) + vn(ji , jj-1,1) )2410 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2411 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2410 2412 END DO 2411 2413 END DO … … 2413 2415 DO jj = 2, jpjm1 2414 2416 DO ji = fs_2, fs_jpim1 ! vector opt. 2415 zotx1(ji,jj) = 0.5 * ( u n (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)2416 zoty1(ji,jj) = 0.5 * ( v n (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)2417 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2418 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 2417 2419 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2418 2420 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) … … 2423 2425 DO jj = 2, jpjm1 2424 2426 DO ji = fs_2, fs_jpim1 ! vector opt. 2425 zotx1(ji,jj) = 0.5 * ( u n (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &2427 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2426 2428 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 2427 zoty1(ji,jj) = 0.5 * ( v n (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &2429 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & 2428 2430 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2429 2431 END DO … … 2474 2476 IF( ln_apr_dyn ) THEN 2475 2477 IF( kt /= nit000 ) THEN 2476 ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2478 ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2477 2479 ELSE 2478 ztmp1(:,:) = ssh b(:,:)2480 ztmp1(:,:) = ssh(:,:,Kbb) 2479 2481 ENDIF 2480 2482 ELSE 2481 ztmp1(:,:) = ssh n(:,:)2483 ztmp1(:,:) = ssh(:,:,Kmm) 2482 2484 ENDIF 2483 2485 CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) … … 2489 2491 ! ! removed inverse barometer ssh when Patm 2490 2492 ! forcing is used (for sea-ice dynamics) 2491 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh b(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )2492 ELSE ; ztmp1(:,:) = ssh n(:,:)2493 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 2494 ELSE ; ztmp1(:,:) = ssh(:,:,Kmm) 2493 2495 ENDIF 2494 2496 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) … … 2497 2499 ! ! SSS 2498 2500 IF( ssnd(jps_soce )%laction ) THEN 2499 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts n(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )2501 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 2500 2502 ENDIF 2501 2503 ! ! first T level thickness 2502 2504 IF( ssnd(jps_e3t1st )%laction ) THEN 2503 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t _n(:,:,1) , (/jpi,jpj,1/) ), info )2505 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info ) 2504 2506 ENDIF 2505 2507 ! ! Qsr fraction … … 2524 2526 ! ! ------------------------- ! 2525 2527 ! needed by Met Office 2526 CALL eos_fzp(ts n(:,:,1,jp_sal), sstfrz)2528 CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) 2527 2529 ztmp1(:,:) = sstfrz(:,:) + rt0 2528 2530 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
Note: See TracChangeset
for help on using the changeset viewer.
