Changeset 12377 for NEMO/trunk/src/OCE/SBC/sbcmod.F90
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcmod.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/SBC/sbcmod.F90
r12276 r12377 15 15 !! 3.6 ! 2014-11 (P. Mathiot, C. Harris) add ice shelves melting 16 16 !! 4.0 ! 2016-06 (L. Brodeau) new general bulk formulation 17 !! 4.0 ! 2019-03 (F. Lemarié & G. Samson) add ABL compatibility (ln_abl=TRUE) 17 18 !!---------------------------------------------------------------------- 18 19 … … 24 25 USE oce ! ocean dynamics and tracers 25 26 USE dom_oce ! ocean space and time domain 27 USE closea ! closed seas 26 28 USE phycst ! physical constants 27 29 USE sbc_oce ! Surface boundary condition: ocean fields … … 32 34 USE sbcflx ! surface boundary condition: flux formulation 33 35 USE sbcblk ! surface boundary condition: bulk formulation 36 USE sbcabl ! atmospheric boundary layer 34 37 USE sbcice_if ! surface boundary condition: ice-if sea-ice model 35 38 #if defined key_si3 … … 37 40 #endif 38 41 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 39 USE sbcisf ! surface boundary condition: ice-shelf40 42 USE sbccpl ! surface boundary condition: coupled formulation 41 43 USE cpl_oasis3 ! OASIS routines for coupling 44 USE sbcclo ! surface boundary condition: closed sea correction 42 45 USE sbcssr ! surface boundary condition: sea surface restoring 43 46 USE sbcrnf ! surface boundary condition: runoffs 44 47 USE sbcapr ! surface boundary condition: atmo pressure 45 USE sbcisf ! surface boundary condition: ice shelf46 48 USE sbcfwb ! surface boundary condition: freshwater budget 47 49 USE icbstp ! Icebergs … … 59 61 USE timing ! Timing 60 62 USE wet_dry 61 USE diu rnal_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic63 USE diu_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic 62 64 63 65 IMPLICIT NONE … … 76 78 CONTAINS 77 79 78 SUBROUTINE sbc_init 80 SUBROUTINE sbc_init( Kbb, Kmm, Kaa ) 79 81 !!--------------------------------------------------------------------- 80 82 !! *** ROUTINE sbc_init *** … … 88 90 !! - nsbc: type of sbc 89 91 !!---------------------------------------------------------------------- 92 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 90 93 INTEGER :: ios, icpt ! local integer 91 94 LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical 92 95 !! 93 96 NAMELIST/namsbc/ nn_fsbc , & 94 & ln_usr , ln_flx , ln_blk ,&97 & ln_usr , ln_flx , ln_blk , ln_abl, & 95 98 & ln_cpl , ln_mixcpl, nn_components, & 96 99 & nn_ice , ln_ice_embd, & 97 100 & ln_traqsr, ln_dm2dc , & 98 & ln_rnf , nn_fwb , ln_ssr , ln_isf , ln_apr_dyn ,&99 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor 101 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 102 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , & 100 103 & ln_tauw , nn_lsm, nn_sdrift 101 104 !!---------------------------------------------------------------------- … … 108 111 ! 109 112 ! !** read Surface Module namelist 110 REWIND( numnam_ref ) !* Namelist namsbc in reference namelist : Surface boundary111 113 READ ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 112 114 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 113 REWIND( numnam_cfg ) !* Namelist namsbc in configuration namelist : Parameters of the run114 115 READ ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 115 116 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) … … 125 126 IF( lk_cice ) nn_ice = 3 126 127 ENDIF 127 #else 128 IF( lk_si3 ) nn_ice = 2 129 IF( lk_cice ) nn_ice = 3 128 !!GS: TBD 129 !#else 130 ! IF( lk_si3 ) nn_ice = 2 131 ! IF( lk_cice ) nn_ice = 3 130 132 #endif 131 133 ! … … 137 139 WRITE(numout,*) ' flux formulation ln_flx = ', ln_flx 138 140 WRITE(numout,*) ' bulk formulation ln_blk = ', ln_blk 141 WRITE(numout,*) ' ABL formulation ln_abl = ', ln_abl 139 142 WRITE(numout,*) ' Type of coupling (Ocean/Ice/Atmosphere) : ' 140 143 WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl … … 153 156 WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn 154 157 WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf 155 WRITE(numout,*) ' iceshelf formulation ln_isf = ', ln_isf156 158 WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm 157 159 WRITE(numout,*) ' surface wave ln_wave = ', ln_wave … … 225 227 CASE( 1 ) !- Ice-cover climatology ("Ice-if" model) 226 228 CASE( 2 ) !- SI3 ice model 229 IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) ) & 230 & CALL ctl_stop( 'sbc_init : SI3 sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 227 231 CASE( 3 ) !- CICE ice model 228 IF( .NOT.( ln_blk .OR. ln_cpl ) ) CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' ) 229 IF( lk_agrif ) CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 232 IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) ) & 233 & CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 234 IF( lk_agrif ) & 235 & CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 230 236 CASE DEFAULT !- not supported 231 237 END SELECT 238 IF( ln_diurnal .AND. .NOT. ln_blk ) CALL ctl_stop( "sbc_init: diurnal flux processing only implemented for bulk forcing" ) 232 239 ! 233 240 ! !** allocate and set required variables … … 239 246 #endif 240 247 ! 241 IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero242 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )243 fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp244 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp245 END IF246 248 ! 247 249 IF( sbc_ssr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) … … 262 264 263 265 ! ! Choice of the Surface Boudary Condition (set nsbc) 266 nday_qsr = -1 ! allow initialization at the 1st call !LB: now warm-layer of COARE* calls "sbc_dcy_param" of sbcdcy.F90! 264 267 IF( ln_dm2dc ) THEN !* daily mean to diurnal cycle 265 nday_qsr = -1 ! allow initialization at the 1st call266 IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa ) &267 & CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulkformulation' )268 !LB:nday_qsr = -1 ! allow initialization at the 1st call 269 IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa ) & 270 & CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 268 271 ENDIF 269 272 ! !* Choice of the Surface Boudary Condition … … 278 281 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 279 282 IF( ln_blk ) THEN ; nsbc = jp_blk ; icpt = icpt + 1 ; ENDIF ! bulk formulation 283 IF( ln_abl ) THEN ; nsbc = jp_abl ; icpt = icpt + 1 ; ENDIF ! ABL formulation 280 284 IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation 281 285 IF( ll_opa ) THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module … … 289 293 CASE( jp_flx ) ; WRITE(numout,*) ' ==>>> flux formulation' 290 294 CASE( jp_blk ) ; WRITE(numout,*) ' ==>>> bulk formulation' 295 CASE( jp_abl ) ; WRITE(numout,*) ' ==>>> ABL formulation' 291 296 CASE( jp_purecpl ) ; WRITE(numout,*) ' ==>>> pure coupled formulation' 292 297 !!gm abusive use of jp_none ?? ===>>> need to be check and changed by adding a jp_sas parameter … … 335 340 ! !** associated modules : initialization 336 341 ! 337 CALL sbc_ssm_init ! Sea-surface mean fields initialization 342 CALL sbc_ssm_init ( Kbb, Kmm ) ! Sea-surface mean fields initialization 343 ! 344 IF( l_sbc_clo ) CALL sbc_clo_init ! closed sea surface initialisation 338 345 ! 339 346 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization 340 347 348 IF( ln_abl ) CALL sbc_abl_init ! Atmospheric Boundary Layer (ABL) 349 341 350 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 342 351 ! 343 IF( ln_isf ) CALL sbc_isf_init ! Compute iceshelves 344 ! 345 CALL sbc_rnf_init ! Runof initialization 346 ! 347 IF( ln_apr_dyn ) CALL sbc_apr_init ! Atmo Pressure Forcing initialization 352 ! 353 CALL sbc_rnf_init( Kmm ) ! Runof initialization 354 ! 355 IF( ln_apr_dyn ) CALL sbc_apr_init ! Atmo Pressure Forcing initialization 348 356 ! 349 357 #if defined key_si3 … … 351 359 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 352 360 ELSEIF( nn_ice == 2 ) THEN 353 CALL ice_init 361 CALL ice_init( Kbb, Kmm, Kaa ) ! ICE initialization 354 362 ENDIF 355 363 #endif 356 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc ) ! CICE initialization357 ! 358 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation364 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc, Kbb, Kmm ) ! CICE initialization 365 ! 366 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 359 367 ! 360 368 IF( lwxios ) THEN … … 371 379 372 380 373 SUBROUTINE sbc( kt )381 SUBROUTINE sbc( kt, Kbb, Kmm ) 374 382 !!--------------------------------------------------------------------- 375 383 !! *** ROUTINE sbc *** … … 388 396 !!---------------------------------------------------------------------- 389 397 INTEGER, INTENT(in) :: kt ! ocean time step 398 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 390 399 ! 391 400 LOGICAL :: ll_sas, ll_opa ! local logical … … 406 415 emp_b (:,:) = emp (:,:) 407 416 sfx_b (:,:) = sfx (:,:) 408 IF 417 IF( ln_rnf ) THEN 409 418 rnf_b (:,: ) = rnf (:,: ) 410 419 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 411 420 ENDIF 412 IF( ln_isf ) THEN413 fwfisf_b (:,: ) = fwfisf (:,: )414 risf_tsc_b(:,:,:) = risf_tsc(:,:,:)415 ENDIF416 421 ! 417 422 ENDIF … … 423 428 ll_opa = nn_components == jp_iam_opa 424 429 ! 425 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt )! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)426 IF( ln_wave ) CALL sbc_wave( kt )! surface waves430 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt, Kbb, Kmm ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 431 IF( ln_wave ) CALL sbc_wave( kt, Kmm ) ! surface waves 427 432 428 433 ! … … 431 436 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 432 437 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 433 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt )! user defined formulation434 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation438 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation 439 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 435 440 CASE( jp_blk ) 436 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA441 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: SAS receiving fields from OPA 437 442 CALL sbc_blk ( kt ) ! bulk formulation for the ocean 438 443 ! 439 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 444 CASE( jp_abl ) 445 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: SAS receiving fields from OPA 446 CALL sbc_abl ( kt ) ! ABL formulation for the ocean 447 ! 448 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! pure coupled formulation 440 449 CASE( jp_none ) 441 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! OPA-SAS coupling: OPA receiving fields from SAS450 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: OPA receiving fields from SAS 442 451 END SELECT 443 452 ! 444 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )! forced-coupled mixed formulation after forcing445 ! 446 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves453 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing 454 ! 455 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves 447 456 ! 448 457 ! !== Misc. Options ==! 449 458 ! 450 459 SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas 451 CASE( 1 ) ; CALL sbc_ice_if ( kt )! Ice-cover climatology ("Ice-if" model)460 CASE( 1 ) ; CALL sbc_ice_if ( kt, Kbb, Kmm ) ! Ice-cover climatology ("Ice-if" model) 452 461 #if defined key_si3 453 CASE( 2 ) ; CALL ice_stp ( kt, nsbc )! SI3 ice model462 CASE( 2 ) ; CALL ice_stp ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model 454 463 #endif 455 464 CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model … … 458 467 IF( ln_icebergs ) THEN 459 468 CALL icb_stp( kt ) ! compute icebergs 460 ! icebergs may advect into haloes during the icb step and alter emp. 461 ! A lbc_lnk is necessary here to ensure restartability (#2113) 469 ! Icebergs do not melt over the haloes. 470 ! So emp values over the haloes are no more consistent with the inner domain values. 471 ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 472 ! see ticket #2113 for discussion about this lbc_lnk. 462 473 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs 463 474 ENDIF 464 475 465 IF( ln_isf ) CALL sbc_isf( kt ) ! compute iceshelves466 467 476 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes 468 477 469 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term470 471 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget478 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term 479 480 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm ) ! control the freshwater budget 472 481 473 482 ! Special treatment of freshwater fluxes over closed seas in the model domain 474 483 ! Should not be run if ln_diurnal_only 475 IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only)) CALL sbc_clo( kt )484 IF( l_sbc_clo ) CALL sbc_clo( kt ) 476 485 477 486 !!$!RBbug do not understand why see ticket 667 478 487 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 479 488 !!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) 480 IF 489 IF( ll_wd ) THEN ! If near WAD point limit the flux for now 481 490 zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999 482 zwdht(:,:) = ssh n(:,:) + ht_0(:,:) - rn_wdmin1 ! do this calc of water491 zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1 ! do this calc of water 483 492 ! depth above wd limit once 484 493 WHERE( zwdht(:,:) <= 0.0 ) … … 510 519 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios ) ! before i-stress (U-point) 511 520 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios ) ! before j-stress (V-point) 512 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios) ! before non solar heat flux (T-point)521 CALL iom_get( numror, jpdom_autoglo, 'qns_b', qns_b, ldxios = lrxios ) ! before non solar heat flux (T-point) 513 522 ! The 3D heat content due to qsr forcing is treated in traqsr 514 523 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios ) ! before solar heat flux (T-point) … … 567 576 CALL iom_put( "vtau", vtau ) ! j-wind stress 568 577 ! 569 IF( ln_ctl) THEN! print mean trends (used for debugging)570 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i- : ', mask1=tmask )571 CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf- : ', mask1=tmask )572 CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf- : ', mask1=tmask )578 IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging) 579 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask ) 580 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask ) 581 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask ) 573 582 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask ) 574 583 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask ) 575 584 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk ) 576 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' sst - : ', mask1=tmask, kdim=1 )577 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_sal), clinfo1=' sss - : ', mask1=tmask, kdim=1 )578 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &579 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask )585 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 ) 586 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 ) 587 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, & 588 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask ) 580 589 ENDIF 581 590
Note: See TracChangeset
for help on using the changeset viewer.
