- 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/sbcmod.F90 (modified) (13 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/sbcmod.F90
r11536 r11949 59 59 USE timing ! Timing 60 60 USE wet_dry 61 USE diu rnal_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic61 USE diu_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic 62 62 63 63 IMPLICIT NONE … … 76 76 CONTAINS 77 77 78 SUBROUTINE sbc_init 78 SUBROUTINE sbc_init( Kbb, Kmm, Kaa ) 79 79 !!--------------------------------------------------------------------- 80 80 !! *** ROUTINE sbc_init *** … … 88 88 !! - nsbc: type of sbc 89 89 !!---------------------------------------------------------------------- 90 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 90 91 INTEGER :: ios, icpt ! local integer 91 92 LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical … … 230 231 CASE DEFAULT !- not supported 231 232 END SELECT 233 IF( ln_diurnal .AND. .NOT. ln_blk ) CALL ctl_stop( "sbc_init: diurnal flux processing only implemented for bulk forcing" ) 232 234 ! 233 235 ! !** allocate and set required variables … … 327 329 ! !** associated modules : initialization 328 330 ! 329 CALL sbc_ssm_init 330 ! 331 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization332 333 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization334 ! 335 IF( ln_isf ) CALL sbc_isf_init 336 ! 337 CALL sbc_rnf_init 338 ! 339 IF( ln_apr_dyn ) CALL sbc_apr_init ! Atmo Pressure Forcing initialization331 CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization 332 ! 333 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization 334 335 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 336 ! 337 IF( ln_isf ) CALL sbc_isf_init( Kmm ) ! Compute iceshelves 338 ! 339 CALL sbc_rnf_init( Kmm ) ! Runof initialization 340 ! 341 IF( ln_apr_dyn ) CALL sbc_apr_init ! Atmo Pressure Forcing initialization 340 342 ! 341 343 #if defined key_si3 … … 343 345 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 344 346 ELSEIF( nn_ice == 2 ) THEN 345 CALL ice_init 347 CALL ice_init( Kbb, Kmm, Kaa ) ! ICE initialization 346 348 ENDIF 347 349 #endif 348 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc ) ! CICE initialization349 ! 350 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation350 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc, Kbb, Kmm ) ! CICE initialization 351 ! 352 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 351 353 ! 352 354 IF( lwxios ) THEN … … 363 365 364 366 365 SUBROUTINE sbc( kt )367 SUBROUTINE sbc( kt, Kbb, Kmm ) 366 368 !!--------------------------------------------------------------------- 367 369 !! *** ROUTINE sbc *** … … 380 382 !!---------------------------------------------------------------------- 381 383 INTEGER, INTENT(in) :: kt ! ocean time step 384 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 382 385 ! 383 386 LOGICAL :: ll_sas, ll_opa ! local logical … … 415 418 ll_opa = nn_components == jp_iam_opa 416 419 ! 417 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt )! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)418 IF( ln_wave ) CALL sbc_wave( kt )! surface waves420 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt, Kbb, Kmm ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 421 IF( ln_wave ) CALL sbc_wave( kt, Kmm ) ! surface waves 419 422 420 423 ! … … 423 426 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 424 427 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 425 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt )! user defined formulation426 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation428 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation 429 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 427 430 CASE( jp_blk ) 428 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! OPA-SAS coupling: SAS receiving fields from OPA429 CALL sbc_blk ( kt ) ! bulk formulation for the ocean431 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: SAS receiving fields from OPA 432 CALL sbc_blk ( kt ) ! bulk formulation for the ocean 430 433 ! 431 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! pure coupled formulation434 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! pure coupled formulation 432 435 CASE( jp_none ) 433 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! OPA-SAS coupling: OPA receiving fields from SAS436 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: OPA receiving fields from SAS 434 437 END SELECT 435 438 ! 436 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! forced-coupled mixed formulation after forcing437 ! 438 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves439 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing 440 ! 441 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves 439 442 ! 440 443 ! !== Misc. Options ==! 441 444 ! 442 445 SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas 443 CASE( 1 ) ; CALL sbc_ice_if ( kt )! Ice-cover climatology ("Ice-if" model)446 CASE( 1 ) ; CALL sbc_ice_if ( kt, Kbb, Kmm ) ! Ice-cover climatology ("Ice-if" model) 444 447 #if defined key_si3 445 CASE( 2 ) ; CALL ice_stp ( kt, nsbc )! SI3 ice model448 CASE( 2 ) ; CALL ice_stp ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model 446 449 #endif 447 450 CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model … … 455 458 ENDIF 456 459 457 IF( ln_isf ) CALL sbc_isf( kt ) ! compute iceshelves458 459 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes460 461 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term462 463 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget460 IF( ln_isf ) CALL sbc_isf( kt, Kmm ) ! compute iceshelves 461 462 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes 463 464 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term 465 466 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm ) ! control the freshwater budget 464 467 465 468 ! Special treatment of freshwater fluxes over closed seas in the model domain … … 472 475 IF ( ll_wd ) THEN ! If near WAD point limit the flux for now 473 476 zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999 474 zwdht(:,:) = ssh n(:,:) + ht_0(:,:) - rn_wdmin1 ! do this calc of water477 zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1 ! do this calc of water 475 478 ! depth above wd limit once 476 479 WHERE( zwdht(:,:) <= 0.0 ) … … 558 561 ! 559 562 IF(ln_ctl) THEN ! print mean trends (used for debugging) 560 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )561 CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf) , clinfo1=' emp-rnf - : ', mask1=tmask )562 CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf) , clinfo1=' sfx-rnf - : ', mask1=tmask )563 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )564 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )565 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )566 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' sst - : ', mask1=tmask, kdim=1 )567 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_sal), clinfo1=' sss - : ', mask1=tmask, kdim=1 )568 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &569 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask )563 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ' , mask1=tmask ) 564 CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf) , clinfo1=' emp-rnf - : ' , mask1=tmask ) 565 CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf) , clinfo1=' sfx-rnf - : ' , mask1=tmask ) 566 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask ) 567 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask ) 568 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk ) 569 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 ) 570 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 ) 571 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, & 572 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask ) 570 573 ENDIF 571 574
Note: See TracChangeset
for help on using the changeset viewer.
