- Timestamp:
- 2015-06-04T20:39:20+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5126 r5357 46 46 PUBLIC sbc_blk_clio ! routine called by sbcmod.F90 47 47 PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90 48 PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90 49 PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90 48 50 49 51 INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read … … 399 401 END SUBROUTINE blk_oce_clio 400 402 401 402 403 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 403 404 & p_taui, p_tauj, p_qns , p_qsr, & … … 405 406 & p_tpr , p_spr , & 406 407 & p_fr1 , p_fr2 , cd_grid, pdim ) 408 407 409 !!--------------------------------------------------------------------------- 408 410 !! *** ROUTINE blk_ice_clio *** 409 !! 411 !! 410 412 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice 411 413 !! surface the solar heat at ocean and snow/ice surfaces and the 412 414 !! sensitivity of total heat fluxes to the SST variations 413 415 !! 414 !! ** Method : The flux of heat at the ice and ocean surfaces are derived 415 !! from semi-empirical ( or bulk ) formulae which relate the flux to 416 !! the properties of the surface and of the lower atmosphere. Here, we 417 !! follow the work of Oberhuber, 1988 418 !! 419 !! ** Action : call albedo_oce/albedo_ice to compute ocean/ice albedo 420 !! - snow precipitation 421 !! - solar flux at the ocean and ice surfaces 422 !! - the long-wave radiation for the ocean and sea/ice 423 !! - turbulent heat fluxes over water and ice 424 !! - evaporation over water 425 !! - total heat fluxes sensitivity over ice (dQ/dT) 426 !! - latent heat flux sensitivity over ice (dQla/dT) 427 !! - qns : modified the non solar heat flux over the ocean 428 !! to take into account solid precip latent heat flux 416 !! ** Action : Call of blk_ice_clio_tau and blk_ice_clio_flx 417 !! 429 418 !!---------------------------------------------------------------------- 419 430 420 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 431 421 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] … … 445 435 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 446 436 INTEGER, INTENT(in ) :: pdim ! number of ice categories 437 438 CALL blk_ice_clio_tau( p_taui, p_tauj, cd_grid ) 439 CALL blk_ice_clio_flx( pst , palb_cs, palb_os, palb, & 440 & p_qns , p_qsr, p_qla , p_dqns, p_dqla, & 441 & p_tpr , p_spr ,p_fr1 , p_fr2 , pdim ) 442 443 END SUBROUTINE blk_ice_clio 444 445 SUBROUTINE blk_ice_clio_tau( p_taui, p_tauj, cd_grid ) 446 !!--------------------------------------------------------------------------- 447 !! *** ROUTINE blk_ice_clio_tau *** 448 !! 449 !! ** Purpose : Computation momentum flux at the ice-atm interface 450 !! 451 !! ** Method : Read utau from a forcing file. Rearrange if C-grid 452 !! 453 !!---------------------------------------------------------------------- 454 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2] 455 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2] 456 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 457 !! 458 INTEGER :: ji, jj ! dummy loop indices 459 REAL(wp) :: zcoef 460 !! 461 !!--------------------------------------------------------------------- 462 ! 463 464 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 465 466 SELECT CASE( cd_grid ) 467 468 CASE( 'C' ) ! C-grid ice dynamics 469 470 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 471 p_taui(:,:) = zcoef * utau(:,:) 472 p_tauj(:,:) = zcoef * vtau(:,:) 473 474 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 475 476 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 477 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 478 DO ji = 2, jpi ! I-grid : no vector opt. 479 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 480 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 481 END DO 482 END DO 483 484 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 485 486 END SELECT 487 488 IF(ln_ctl) THEN 489 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 490 ENDIF 491 492 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 493 494 END SUBROUTINE blk_ice_clio_tau 495 496 SUBROUTINE blk_ice_clio_flx( pst , palb_cs, palb_os, palb, & 497 & p_qns , p_qsr, p_qla , p_dqns, p_dqla, & 498 & p_tpr , p_spr ,p_fr1 , p_fr2 , pdim ) 499 !!--------------------------------------------------------------------------- 500 !! *** ROUTINE blk_ice_clio_flx *** 501 !! 502 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice 503 !! surface the solar heat at ocean and snow/ice surfaces and the 504 !! sensitivity of total heat fluxes to the SST variations 505 !! 506 !! ** Method : The flux of heat at the ice and ocean surfaces are derived 507 !! from semi-empirical ( or bulk ) formulae which relate the flux to 508 !! the properties of the surface and of the lower atmosphere. Here, we 509 !! follow the work of Oberhuber, 1988 510 !! 511 !! ** Action : call albedo_oce/albedo_ice to compute ocean/ice albedo 512 !! - snow precipitation 513 !! - solar flux at the ocean and ice surfaces 514 !! - the long-wave radiation for the ocean and sea/ice 515 !! - turbulent heat fluxes over water and ice 516 !! - evaporation over water 517 !! - total heat fluxes sensitivity over ice (dQ/dT) 518 !! - latent heat flux sensitivity over ice (dQla/dT) 519 !! - qns : modified the non solar heat flux over the ocean 520 !! to take into account solid precip latent heat flux 521 !!---------------------------------------------------------------------- 522 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 523 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 524 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 525 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 526 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 527 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 528 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 529 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 530 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 531 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 532 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 533 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-] 534 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-] 535 INTEGER, INTENT(in ) :: pdim ! number of ice categories 447 536 !! 448 537 INTEGER :: ji, jj, jl ! dummy loop indices 449 538 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 450 539 !! 451 REAL(wp) :: z coef, zmt1, zmt2, zmt3, ztatm3! temporary scalars540 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 452 541 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 453 542 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 463 552 !!--------------------------------------------------------------------- 464 553 ! 465 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')554 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 466 555 ! 467 556 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) … … 471 560 zpatm = 101000. ! atmospheric pressure (assumed constant here) 472 561 473 #if defined key_lim3 474 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 475 #endif 476 ! ! surface ocean fluxes computed with CLIO bulk formulea 477 !------------------------------------! 478 ! momentum fluxes (utau, vtau ) ! 479 !------------------------------------! 480 481 SELECT CASE( cd_grid ) 482 CASE( 'C' ) ! C-grid ice dynamics 483 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 484 p_taui(:,:) = zcoef * utau(:,:) 485 p_tauj(:,:) = zcoef * vtau(:,:) 486 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 487 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 488 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 489 DO ji = 2, jpi ! I-grid : no vector opt. 490 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 491 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 492 END DO 493 END DO 494 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 495 END SELECT 496 497 562 !-------------------------------------------------------------------------------- 498 563 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 499 564 ! and the correction factor for taking into account the effect of clouds 500 !------------------------------------------------------ 565 !-------------------------------------------------------------------------------- 566 501 567 !CDIR NOVERRCHK 502 568 !CDIR COLLAPSE … … 653 719 CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl) 654 720 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 655 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')656 721 ENDIF 657 722 … … 659 724 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 660 725 ! 661 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 662 ! 663 END SUBROUTINE blk_ice_clio 664 726 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 727 ! 728 END SUBROUTINE blk_ice_clio_flx 665 729 666 730 SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
Note: See TracChangeset
for help on using the changeset viewer.
