Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcmod.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcmod.F90
r13722 r14789 16 16 !! 4.0 ! 2016-06 (L. Brodeau) new general bulk formulation 17 17 !! 4.0 ! 2019-03 (F. Lemarié & G. Samson) add ABL compatibility (ln_abl=TRUE) 18 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) modified wave forcing and coupling 18 19 !!---------------------------------------------------------------------- 19 20 … … 27 28 USE closea ! closed seas 28 29 USE phycst ! physical constants 30 USE sbc_phy, ONLY : pp_cldf 29 31 USE sbc_oce ! Surface boundary condition: ocean fields 30 32 USE trc_oce ! shared ocean-passive tracers variables … … 45 47 USE sbcssr ! surface boundary condition: sea surface restoring 46 48 USE sbcrnf ! surface boundary condition: runoffs 47 USE sbcapr ! surface boundary condition: atmo pressure 49 USE sbcapr ! surface boundary condition: atmo pressure 48 50 USE sbcfwb ! surface boundary condition: freshwater budget 49 51 USE icbstp ! Icebergs … … 54 56 USE usrdef_sbc ! user defined: surface boundary condition 55 57 USE closea ! closed sea 58 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 56 59 ! 57 60 USE prtctl ! Print control (prt_ctl routine) … … 70 73 71 74 INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations) 72 75 !! * Substitutions 76 # include "do_loop_substitute.h90" 73 77 !!---------------------------------------------------------------------- 74 78 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 99 103 & nn_ice , ln_ice_embd, & 100 104 & ln_traqsr, ln_dm2dc , & 101 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 102 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , & 103 & ln_tauw , nn_lsm, nn_sdrift 105 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 106 & ln_wave , nn_lsm 104 107 !!---------------------------------------------------------------------- 105 108 ! … … 117 120 IF(lwm) WRITE( numond, namsbc ) 118 121 ! 119 #if defined key_mpp_mpi122 #if ! defined key_mpi_off 120 123 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 121 124 #endif … … 133 136 WRITE(numout,*) ' bulk formulation ln_blk = ', ln_blk 134 137 WRITE(numout,*) ' ABL formulation ln_abl = ', ln_abl 138 WRITE(numout,*) ' Surface wave (forced or coupled) ln_wave = ', ln_wave 135 139 WRITE(numout,*) ' Type of coupling (Ocean/Ice/Atmosphere) : ' 136 140 WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl 137 141 WRITE(numout,*) ' mixed forced-coupled formulation ln_mixcpl = ', ln_mixcpl 138 !!gm lk_oasis is controlled by key_oasis3 ===>>> It shoud be removed from the namelist 142 !!gm lk_oasis is controlled by key_oasis3 ===>>> It shoud be removed from the namelist 139 143 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 140 144 WRITE(numout,*) ' components of your executable nn_components = ', nn_components … … 150 154 WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf 151 155 WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm 152 WRITE(numout,*) ' surface wave ln_wave = ', ln_wave 153 WRITE(numout,*) ' Stokes drift corr. to vert. velocity ln_sdw = ', ln_sdw 154 WRITE(numout,*) ' vertical parametrization nn_sdrift = ', nn_sdrift 155 WRITE(numout,*) ' wave modified ocean stress ln_tauwoc = ', ln_tauwoc 156 WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw 157 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor 158 WRITE(numout,*) ' neutral drag coefficient (CORE,NCAR) ln_cdgw = ', ln_cdgw 159 ENDIF 160 ! 161 IF( .NOT.ln_wave ) THEN 162 ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 163 ENDIF 164 IF( ln_sdw ) THEN 165 IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & 166 CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' ) 167 ENDIF 168 ll_st_bv2014 = ( nn_sdrift==jp_breivik_2014 ) 169 ll_st_li2017 = ( nn_sdrift==jp_li_2017 ) 170 ll_st_bv_li = ( ll_st_bv2014 .OR. ll_st_li2017 ) 171 ll_st_peakfr = ( nn_sdrift==jp_peakfr ) 172 IF( ln_tauwoc .AND. ln_tauw ) & 173 CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 174 '(ln_tauwoc=.true. and ln_tauw=.true.)' ) 175 IF( ln_tauwoc ) & 176 CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' ) 177 IF( ln_tauw ) & 178 CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', & 179 'This will override any other specification of the ocean stress' ) 156 ENDIF 180 157 ! 181 158 IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case) … … 186 163 ! !** check option consistency 187 164 ! 188 IF(lwp) WRITE(numout,*) !* Single / Multi - executable (NEMO / O PA+SAS)165 IF(lwp) WRITE(numout,*) !* Single / Multi - executable (NEMO / OCE+SAS) 189 166 SELECT CASE( nn_components ) 190 167 CASE( jp_iam_nemo ) 191 IF(lwp) WRITE(numout,*) ' ==>>> NEMO configured as a single executable (i.e. including both O PAand Surface module)'192 CASE( jp_iam_o pa)193 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, O PAcomponent'194 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but key_oasis3 disabled' )195 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_cpl = T in OPA' )196 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )168 IF(lwp) WRITE(numout,*) ' ==>>> NEMO configured as a single executable (i.e. including both OCE and Surface module)' 169 CASE( jp_iam_oce ) 170 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, OCE component' 171 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 172 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_cpl = T in OCE' ) 173 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 197 174 CASE( jp_iam_sas ) 198 175 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, SAS component' 199 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but key_oasis3 disabled' )200 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )176 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 177 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 201 178 CASE DEFAULT 202 179 CALL ctl_stop( 'sbc_init : unsupported value for nn_components' ) … … 218 195 SELECT CASE( nn_ice ) 219 196 CASE( 0 ) !- no ice in the domain 220 CASE( 1 ) !- Ice-cover climatology ("Ice-if" model) 197 CASE( 1 ) !- Ice-cover climatology ("Ice-if" model) 221 198 CASE( 2 ) !- SI3 ice model 222 199 IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) ) & … … 226 203 & CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' ) 227 204 IF( lk_agrif ) & 228 & CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 205 & CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 229 206 CASE DEFAULT !- not supported 230 207 END SELECT … … 241 218 ! 242 219 IF( sbc_ssr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 243 IF( .NOT.ln_ssr ) THEN !* Initialize qrp and erp if no restoring 220 IF( .NOT.ln_ssr ) THEN !* Initialize qrp and erp if no restoring 244 221 qrp(:,:) = 0._wp 245 222 erp(:,:) = 0._wp … … 247 224 ! 248 225 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 249 IF( nn_components /= jp_iam_o pa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPAcoupled case226 IF( nn_components /= jp_iam_oce ) fr_i(:,:) = 0._wp ! except for OCE in SAS-OCE coupled case 250 227 ENDIF 251 228 ! … … 260 237 IF( ln_dm2dc ) THEN !* daily mean to diurnal cycle 261 238 !LB:nday_qsr = -1 ! allow initialization at the 1st call 262 IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_o pa) &239 IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_oce ) & 263 240 & CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 264 241 ENDIF … … 267 244 ! 268 245 ll_purecpl = ln_cpl .AND. .NOT.ln_mixcpl 269 ll_opa = nn_components == jp_iam_o pa246 ll_opa = nn_components == jp_iam_oce 270 247 ll_not_nemo = nn_components /= jp_iam_nemo 271 248 icpt = 0 … … 289 266 CASE( jp_purecpl ) ; WRITE(numout,*) ' ==>>> pure coupled formulation' 290 267 !!gm abusive use of jp_none ?? ===>>> need to be check and changed by adding a jp_sas parameter 291 CASE( jp_none ) ; WRITE(numout,*) ' ==>>> O PAcoupled to SAS via oasis'268 CASE( jp_none ) ; WRITE(numout,*) ' ==>>> OCE coupled to SAS via oasis' 292 269 IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation' 293 270 END SELECT … … 299 276 IF( lk_oasis ) CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 300 277 ! ! (2) the use of nn_fsbc 301 ! nn_fsbc initialization if O PA-SAS coupling via OASIS278 ! nn_fsbc initialization if OCE-SAS coupling via OASIS 302 279 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 303 280 IF( nn_components /= jp_iam_nemo ) THEN 304 IF( nn_components == jp_iam_o pa) nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt)281 IF( nn_components == jp_iam_oce ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 305 282 IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt) 306 283 ! 307 284 IF(lwp)THEN 308 285 WRITE(numout,*) 309 WRITE(numout,*)" O PA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc286 WRITE(numout,*)" OCE-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 310 287 WRITE(numout,*) 311 288 ENDIF … … 330 307 & CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 331 308 ! 332 309 333 310 ! !** associated modules : initialization 334 311 ! … … 357 334 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc, Kbb, Kmm ) ! CICE initialization 358 335 ! 359 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 360 ! 361 IF( lwxios ) THEN 362 CALL iom_set_rstw_var_active('utau_b') 363 CALL iom_set_rstw_var_active('vtau_b') 364 CALL iom_set_rstw_var_active('qns_b') 365 ! The 3D heat content due to qsr forcing is treated in traqsr 366 ! CALL iom_set_rstw_var_active('qsr_b') 367 CALL iom_set_rstw_var_active('emp_b') 368 CALL iom_set_rstw_var_active('sfx_b') 369 ENDIF 370 336 IF( ln_wave ) THEN 337 CALL sbc_wave_init ! surface wave initialisation 338 ELSE 339 IF(lwp) WRITE(numout,*) 340 IF(lwp) WRITE(numout,*) ' No surface waves : all wave related logical set to false' 341 ln_sdw = .false. 342 ln_stcor = .false. 343 ln_cdgw = .false. 344 ln_tauoc = .false. 345 ln_wave_test = .false. 346 ln_charn = .false. 347 ln_taw = .false. 348 ln_phioc = .false. 349 ln_bern_srfc = .false. 350 ln_breivikFV_2016 = .false. 351 ln_vortex_force = .false. 352 ln_stshear = .false. 353 ENDIF 354 ! 371 355 END SUBROUTINE sbc_init 372 356 … … 390 374 INTEGER, INTENT(in) :: kt ! ocean time step 391 375 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 376 INTEGER :: jj, ji ! dummy loop argument 392 377 ! 393 378 LOGICAL :: ll_sas, ll_opa ! local logical 394 379 ! 395 380 REAL(wp) :: zthscl ! wd tanh scale 396 REAL(wp), DIMENSION(jpi,jpj) :: zwdht, zwght ! wd dep over wd limit, wgt 381 REAL(wp), DIMENSION(jpi,jpj) :: zwdht, zwght ! wd dep over wd limit, wgt 397 382 398 383 !!--------------------------------------------------------------------- … … 419 404 ! 420 405 ll_sas = nn_components == jp_iam_sas ! component flags 421 ll_opa = nn_components == jp_iam_o pa406 ll_opa = nn_components == jp_iam_oce 422 407 ! 423 408 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt, Kbb, Kmm ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 424 IF( ln_wave ) CALL sbc_wave( kt, Kmm ) ! surface waves425 426 409 ! 427 410 ! !== sbc formulation ==! 428 ! 411 ! 412 ! 429 413 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 430 414 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 431 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation 415 CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation 432 416 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 433 417 CASE( jp_blk ) 434 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: SAS receiving fields from OPA 418 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE 419 !!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 420 IF( ln_wave ) THEN 421 IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-wave coupling 422 CALL sbc_wave ( kt, Kmm ) 423 ENDIF 435 424 CALL sbc_blk ( kt ) ! bulk formulation for the ocean 436 425 ! 437 426 CASE( jp_abl ) 438 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-SAS coupling: SAS receiving fields from OPA427 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE 439 428 CALL sbc_abl ( kt ) ! ABL formulation for the ocean 440 429 ! 441 430 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! pure coupled formulation 442 431 CASE( jp_none ) 443 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-SAS coupling: OPAreceiving fields from SAS432 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: OCE receiving fields from SAS 444 433 END SELECT 445 434 ! 446 435 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing 447 436 ! 448 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves 437 IF( ln_wave .AND. ln_tauoc ) THEN ! Wave stress reduction 438 DO_2D( 0, 0, 0, 0) 439 utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji-1,jj) ) * 0.5_wp 440 vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj-1) ) * 0.5_wp 441 END_2D 442 ! 443 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 444 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 445 ! 446 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 447 ! 448 IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', & 449 & 'If not requested select ln_tauoc=.false.' ) 450 ! 451 ELSEIF( ln_wave .AND. ln_taw ) THEN ! Wave stress reduction 452 utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 453 vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 454 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 455 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 456 ! 457 DO_2D( 0, 0, 0, 0) 458 taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2) 459 END_2D 460 ! 461 IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', & 462 & 'If not requested select ln_taw=.false.' ) 463 ! 464 ENDIF 465 CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 449 466 ! 450 467 ! !== Misc. Options ==! … … 459 476 460 477 IF( ln_icebergs ) THEN 461 CALL icb_stp( kt ) ! compute icebergs462 ! Icebergs do not melt over the haloes. 463 ! So emp values over the haloes are no more consistent with the inner domain values. 478 CALL icb_stp( kt, Kmm ) ! compute icebergs 479 ! Icebergs do not melt over the haloes. 480 ! So emp values over the haloes are no more consistent with the inner domain values. 464 481 ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 465 482 ! see ticket #2113 for discussion about this lbc_lnk. … … 475 492 ! Special treatment of freshwater fluxes over closed seas in the model domain 476 493 ! Should not be run if ln_diurnal_only 477 IF( l_sbc_clo ) CALL sbc_clo( kt ) 494 IF( l_sbc_clo ) CALL sbc_clo( kt ) 478 495 479 496 !!$!RBbug do not understand why see ticket 667 … … 481 498 !!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 482 499 IF( ll_wd ) THEN ! If near WAD point limit the flux for now 483 zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999 500 zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999 484 501 zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1 ! do this calc of water 485 502 ! depth above wd limit once … … 507 524 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 508 525 ! ! ---------------------------------------- ! 509 IF( ln_rstart .AND. & !* Restart: read in restart file 510 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 511 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 512 CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b, ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) ! before i-stress (U-point) 513 CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b, ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) ! before j-stress (V-point) 514 CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b, ldxios = lrxios ) ! before non solar heat flux (T-point) 515 ! The 3D heat content due to qsr forcing is treated in traqsr 516 ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b, ldxios = lrxios ) ! before solar heat flux (T-point) 517 CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b, ldxios = lrxios ) ! before freshwater flux (T-point) 526 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN !* Restart: read in restart file 527 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields read in the restart file' 528 CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b ) ! i-stress 529 CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b ) ! j-stress 530 CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b ) ! non solar heat flux 531 CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b ) ! freshwater flux 532 ! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr 518 533 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 519 534 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 520 CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b , ldxios = lrxios) ! before salt flux (T-point)535 CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b ) ! before salt flux (T-point) 521 536 ELSE 522 537 sfx_b (:,:) = sfx(:,:) … … 538 553 & 'at it= ', kt,' date= ', ndastp 539 554 IF(lwp) WRITE(numout,*) '~~~~' 540 IF( lwxios ) CALL iom_swap( cwxios_context ) 541 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios ) 542 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios ) 543 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns, ldxios = lwxios ) 555 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 556 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 557 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns ) 544 558 ! The 3D heat content due to qsr forcing is treated in traqsr 545 559 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 546 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp, ldxios = lwxios ) 547 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx, ldxios = lwxios ) 548 IF( lwxios ) CALL iom_swap( cxios_context ) 560 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 561 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 549 562 ENDIF 550 563 ! ! ---------------------------------------- ! … … 552 565 ! ! ---------------------------------------- ! 553 566 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 554 CALL iom_put( "empmr" , emp 555 CALL iom_put( "empbmr" , emp_b 556 CALL iom_put( "saltflx", sfx )! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)557 CALL iom_put( "fmmflx" , fmmflx )! Freezing-melting water flux558 CALL iom_put( "qt" , qns + qsr )! total heat flux559 CALL iom_put( "qns" , qns )! solar heat flux560 CALL iom_put( "qsr" , qsr )! solar heat flux567 CALL iom_put( "empmr" , emp - rnf ) ! upward water flux 568 CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 569 CALL iom_put( "saltflx", sfx ) ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 570 CALL iom_put( "fmmflx" , fmmflx ) ! Freezing-melting water flux 571 CALL iom_put( "qt" , qns + qsr ) ! total heat flux 572 CALL iom_put( "qns" , qns ) ! solar heat flux 573 CALL iom_put( "qsr" , qsr ) ! solar heat flux 561 574 IF( nn_ice > 0 .OR. ll_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 562 CALL iom_put( "taum" , taum )! wind stress module563 CALL iom_put( "wspd" , wndm )! wind speed module over free ocean or leads in presence of sea-ice564 CALL iom_put( "qrp" , qrp )! heat flux damping565 CALL iom_put( "erp" , erp )! freshwater flux damping575 CALL iom_put( "taum" , taum ) ! wind stress module 576 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 577 CALL iom_put( "qrp" , qrp ) ! heat flux damping 578 CALL iom_put( "erp" , erp ) ! freshwater flux damping 566 579 ENDIF 567 580 ! 568 581 IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging) 569 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )570 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask )571 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask )572 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )573 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )574 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )582 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask ) 583 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask ) 584 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask ) 585 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask ) 586 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask ) 587 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk ) 575 588 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 ) 576 589 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
Note: See TracChangeset
for help on using the changeset viewer.