Changeset 11360
- Timestamp:
- 2019-07-26T20:07:25+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src
- Files:
-
- 5 edited
-
ABL/sbcabl.F90 (modified) (2 diffs)
-
ICE/icesbc.F90 (modified) (1 diff)
-
OCE/DIA/diawri.F90 (modified) (3 diffs)
-
OCE/IOM/iom.F90 (modified) (1 diff)
-
OCE/SBC/sbcblk.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ABL/sbcabl.F90
r11348 r11360 335 335 336 336 #if defined key_si3 337 CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 338 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 339 & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice , & ! <<= in 340 & pseni=zseni, pevpi=zevpi, ptsui=tm_su , & ! <<= out 341 & pssqi=zssqi, pcd_dui=zcd_dui ) ! =>> out 337 CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 338 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 339 & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice, tm_su , & ! <<= in 340 & pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui ) ! <<= out 342 341 #endif 343 342 … … 364 363 !!------------------------------------------------------------------------------------------- 365 364 366 CALL blk_oce_2( kt,tq_abl(:,:,2,nt_n,jp_ta), &367 & 368 & 369 & 365 CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta), & 366 & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1), & 367 & sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1), & 368 & sst_m, zsen, zevp ) 370 369 371 370 #if defined key_si3 -
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icesbc.F90
r11348 r11360 72 72 CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation 73 73 CASE( jp_blk ) ; CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & 74 & sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1),&75 & u_ice, v_ice, &! inputs76 & putaui = utau_ice, pvtaui = vtau_ice )! outputs74 & sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), & 75 & sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su , & ! inputs 76 & putaui = utau_ice, pvtaui = vtau_ice ) ! outputs 77 77 ! CASE( jp_abl ) utau_ice & vtau_ice are computed in ablmod 78 78 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation -
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diawri.F90
r11348 r11360 75 75 INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file 76 76 INTEGER :: nid_W, nz_W, nh_W ! grid_W file 77 INTEGER :: ndim_A, ndim_hA ! grid_Tfile77 INTEGER :: ndim_A, ndim_hA ! ABL file 78 78 INTEGER :: nid_A, nz_A, nh_A ! grid_ABL file 79 79 INTEGER :: ndex(1) ! ??? 80 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV, ndex_hA 81 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V, ndex_A 80 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 81 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 82 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 82 83 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 83 84 … … 445 446 INTEGER :: ji, jj, jk ! dummy loop indices 446 447 INTEGER :: ierr ! error code return from allocation 447 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma, ipka ! local integers 448 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 449 INTEGER :: ipka ! ABL 448 450 INTEGER :: jn, ierror ! local integers 449 451 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars … … 451 453 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 452 454 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 453 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! 3D workspace455 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 454 456 !!---------------------------------------------------------------------- 455 457 ! -
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/IOM/iom.F90
r11304 r11360 112 112 ! 113 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 114 REAL(wp), DIMENSION(2 ,jpkam1) :: za_bnds! ABL vertical boundaries114 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 115 115 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 116 116 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files -
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcblk.F90
r11348 r11360 48 48 USE lib_fortran ! to use key_nosignedzero 49 49 #if defined key_si3 50 USE ice , ONLY : jpl, a_i_b, at_i_b, t_su,rn_cnd_s, hfx_err_dif50 USE ice , ONLY : jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif 51 51 USE icethd_dh ! for CALL ice_thd_snwblow 52 52 #endif … … 77 77 #endif 78 78 79 80 81 79 INTERFACE cp_air 80 MODULE PROCEDURE cp_air_0d, cp_air_2d 81 END INTERFACE 82 82 83 83 ! !!* Namelist namsbc_blk : bulk parameters … … 106 106 REAL(wp) , PARAMETER :: Cp_dry = 1005.0 ! Specic heat of dry air, constant pressure [J/K/kg] 107 107 REAL(wp) , PARAMETER :: Cp_vap = 1860.0 ! Specic heat of water vapor, constant pressure [J/K/kg] 108 REAL(wp), PUBLIC, PARAMETER :: R_dry 108 REAL(wp), PUBLIC, PARAMETER :: R_dry = 287.05_wp !: Specific gas constant for dry air [J/K/kg] 109 109 REAL(wp) , PARAMETER :: R_vap = 461.495_wp ! Specific gas constant for water vapor [J/K/kg] 110 110 REAL(wp) , PARAMETER :: reps0 = R_dry/R_vap ! ratio of gas constant for dry air and water vapor => ~ 0.622 111 REAL(wp), PUBLIC, PARAMETER :: rctv0 111 REAL(wp), PUBLIC, PARAMETER :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 112 112 ! !!! Bulk parameters 113 113 REAL(wp) , PARAMETER :: cpa = 1000.5 ! specific heat of air (only used for ice fluxes now...) 114 114 REAL(wp) , PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 115 115 REAL(wp) , PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 116 REAL(wp) , PARAMETER :: Cd_ice = 1.4e-3 ! transfer coefficient over ice116 REAL(wp) , PARAMETER :: rcdice = 1.4e-3 ! transfer coefficient over ice 117 117 REAL(wp) , PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 118 118 ! 119 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_atm , Ch_atm , Ce_atm ! transfer coeffs. for momentum, sensible heat, and evaporation120 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs (needed for Lupkes et al. 2015 bulk scheme)121 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (needed for Lupkes 2015 bulk scheme)119 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice 120 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs over ocean (L15 bulk scheme) 121 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 122 122 123 123 INTEGER , PUBLIC, PARAMETER :: jpfld =11 !: maximum number of files to read … … 149 149 !! *** ROUTINE sbc_blk_alloc *** 150 150 !!------------------------------------------------------------------- 151 ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 152 & Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 151 ALLOCATE( t_zu(jpi,jpj), q_zu(jpi,jpj), & 152 & Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), & 153 & Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 153 154 ! 154 155 CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) … … 268 269 rn_zu = ght_abl(2) 269 270 IF(lwp) WRITE(numout,*) 270 IF(lwp) WRITE(numout,*) ' ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 271 ENDIF 272 ! 271 IF(lwp) WRITE(numout,*) ' ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 272 ENDIF 273 ! 274 ! set transfer coefficients to default sea-ice values 275 Cd_ice(:,:) = rcdice 276 Ch_ice(:,:) = rcdice 277 Ce_ice(:,:) = rcdice 278 ! 273 279 IF(lwp) THEN !** Control print 274 280 ! … … 349 355 & zssq, zcd_du, zsen, zevp ) ! =>> out 350 356 351 CALL blk_oce_2( kt,sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in357 CALL blk_oce_2( sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in 352 358 & sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), & ! <<= in 353 359 & sf(jp_snow)%fnow(:,:,1), sst_m, & ! <<= in … … 410 416 REAL(wp), DIMENSION(jpi,jpj) :: ztpot ! potential temperature of air at z=rn_zqt [K] 411 417 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! density of air [kg/m^3] 418 REAL(wp), DIMENSION(jpi,jpj) :: zcd_oce ! momentum transfert coefficient over ocean 419 REAL(wp), DIMENSION(jpi,jpj) :: zch_oce ! sensible heat transfert coefficient over ocean 420 REAL(wp), DIMENSION(jpi,jpj) :: zce_oce ! latent heat transfert coefficient over ocean 412 421 !!--------------------------------------------------------------------- 413 422 ! … … 461 470 ! 462 471 CASE( np_NCAR ) ; CALL turb_ncar ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! NCAR-COREv2 463 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce )472 & zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 464 473 CASE( np_COARE_3p0 ) ; CALL turb_coare ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! COARE v3.0 465 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce )474 & zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 466 475 CASE( np_COARE_3p5 ) ; CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! COARE v3.5 467 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce )476 & zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 468 477 CASE( np_ECMWF ) ; CALL turb_ecmwf ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! ECMWF 469 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce )478 & zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 470 479 CASE DEFAULT 471 480 CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) … … 479 488 zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 480 489 wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod 481 pcd_du(ji,jj) = zztmp * Cd_atm(ji,jj)482 psen(ji,jj) = zztmp * Ch_atm(ji,jj)483 pevp(ji,jj) = zztmp * Ce_atm(ji,jj)490 pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 491 psen(ji,jj) = zztmp * zch_oce(ji,jj) 492 pevp(ji,jj) = zztmp * zce_oce(ji,jj) 484 493 END DO 485 494 END DO … … 498 507 zztmp = zrhoa(ji,jj) * zU_zu(ji,jj) 499 508 !!gm to be done by someone: check the efficiency of the call of cp_air within do loops 500 psen (ji,jj) = cp_air( q_zu(ji,jj) ) * zztmp * Ch_atm(ji,jj) * ( zst(ji,jj) - t_zu(ji,jj) )501 pevp (ji,jj) = rn_efac*MAX( 0._wp, zztmp * Ce_atm(ji,jj) * ( pssq(ji,jj) - q_zu(ji,jj) ) )502 zztmp = zztmp * Cd_atm(ji,jj)509 psen (ji,jj) = cp_air( q_zu(ji,jj) ) * zztmp * zch_oce(ji,jj) * ( zst(ji,jj) - t_zu(ji,jj) ) 510 pevp (ji,jj) = rn_efac*MAX( 0._wp, zztmp * zce_oce(ji,jj) * ( pssq(ji,jj) - q_zu(ji,jj) ) ) 511 zztmp = zztmp * zcd_oce(ji,jj) 503 512 pcd_du(ji,jj) = zztmp 504 513 taum (ji,jj) = zztmp * wndm (ji,jj) … … 540 549 541 550 542 SUBROUTINE blk_oce_2( kt,ptair, pqsr, pqlw, pprec, & ! <<= in543 & 551 SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec, & ! <<= in 552 & psnow, pst , psen, pevp ) ! <<= in 544 553 !!--------------------------------------------------------------------- 545 554 !! *** ROUTINE blk_oce_2 *** … … 557 566 !! - emp : evaporation minus precipitation (kg/m2/s) 558 567 !!--------------------------------------------------------------------- 559 INTEGER , INTENT(in) :: kt ! time step index560 568 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptair 561 569 REAL(wp), INTENT(in), DIMENSION(:,:) :: pqsr … … 639 647 CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla : ', tab2d_2=qsr , clinfo2=' qsr : ') 640 648 CALL prt_ctl(tab2d_1=emp , clinfo1=' blk_oce_2: emp : ') 641 ENDIF 642 649 ENDIF 650 ! 643 651 END SUBROUTINE blk_oce_2 644 652 … … 789 797 !!---------------------------------------------------------------------- 790 798 791 SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, &! inputs792 & putaui, pvtaui, pseni, pevpi, p tsui, pssqi, pcd_dui ) !outputs799 SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui, & ! inputs 800 & putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui ) ! optional outputs 793 801 !!--------------------------------------------------------------------- 794 802 !! *** ROUTINE blk_ice_1 *** … … 807 815 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: puice ! sea-ice velocity on I or C grid [m/s] 808 816 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pvice ! " 817 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptsui ! sea-ice surface temperature [K] 809 818 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: putaui ! if ln_blk 810 819 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pvtaui ! if ln_blk 811 820 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pseni ! if ln_abl 812 821 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pevpi ! if ln_abl 813 REAL(wp) , INTENT(in ), DIMENSION(:,: ), OPTIONAL :: ptsui ! if ln_abl814 822 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pssqi ! if ln_abl 815 823 REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pcd_dui ! if ln_abl 816 824 ! 817 825 INTEGER :: ji, jj ! dummy loop indices 818 REAL(wp) :: zwndi_t , zwndj_t, zootm_su, zztmp1, zztmp2 ! relative wind components at T-point 826 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 827 REAL(wp) :: zootm_su ! sea-ice surface mean temperature 828 REAL(wp) :: zztmp1, zztmp2 ! temporary arrays 819 829 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! transfer coefficient for momentum (tau) 820 REAL(wp), DIMENSION(jpi,jpj) :: zcd_dui ! transfer coefficient for momentum (tau) 821 !!--------------------------------------------------------------------- 822 ! 823 ! set transfer coefficients to default sea-ice values 824 Cd_atm(:,:) = Cd_ice 825 Ch_atm(:,:) = Cd_ice 826 Ce_atm(:,:) = Cd_ice 830 REAL(wp), DIMENSION(jpi,jpj) :: zcd_dui ! transfer coefficient for momentum (tau) 831 !!--------------------------------------------------------------------- 827 832 828 833 ! ------------------------------------------------------------ ! … … 841 846 ! Make ice-atm. drag dependent on ice concentration 842 847 IF ( ln_Cd_L12 ) THEN ! calculate new drag from Lupkes(2012) equations 843 CALL Cdn10_Lupkes2012( Cd_atm ) 844 Ch_atm(:,:) = Cd_atm(:,:) ! momentum and heat transfer coef. are considered identical 848 CALL Cdn10_Lupkes2012( Cd_ice ) 849 Ch_ice(:,:) = Cd_ice(:,:) ! momentum and heat transfer coef. are considered identical 850 Ce_ice(:,:) = Cd_ice(:,:) 845 851 ELSEIF( ln_Cd_L15 ) THEN ! calculate new drag from Lupkes(2015) equations 846 CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 847 ENDIF 848 849 !! CALL iom_put( "Cd_ice", Cd_atm) ! output value of pure ice-atm. transfer coef. 850 !! CALL iom_put( "Ch_ice", Ch_atm) ! output value of pure ice-atm. transfer coef. 852 CALL Cdn10_Lupkes2015( ptsui, Cd_ice, Ch_ice ) 853 Ce_ice(:,:) = Ch_ice(:,:) ! sensible and latent heat transfer coef. are considered identical 854 ENDIF 855 856 IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice) ! output value of pure ice-atm. transfer coef. 857 IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice) ! output value of pure ice-atm. transfer coef. 851 858 852 859 ! local scalars ( place there for vector optimisation purposes) 853 860 ! Computing density of air! Way denser that 1.2 over sea-ice !!! 854 861 zrhoa (:,:) = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) 855 zcd_dui(:,:) = wndm_ice(:,:) * Cd_ atm(:,:)862 zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 856 863 857 864 IF( ln_blk ) THEN … … 876 883 ELSE 877 884 zztmp1 = 11637800.0_wp 878 879 885 zztmp2 = -5897.8_wp 886 DO jj = 1, jpj 880 887 DO ji = 1, jpi 881 888 pcd_dui(ji,jj) = zcd_dui (ji,jj) 882 pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ atm(ji,jj)883 pevpi (ji,jj) = wndm_ice(ji,jj) * Ce_ atm(ji,jj)884 885 889 pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 890 pevpi (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 891 zootm_su = zztmp2 / ptsui(ji,jj) ! ptsui is in K (it can't be zero ??) 892 pssqi (ji,jj) = zztmp1 * EXP( zootm_su ) / zrhoa(ji,jj) 886 893 END DO 887 894 END DO … … 905 912 !! caution : the net upward water flux has with mm/day unit 906 913 !!--------------------------------------------------------------------- 907 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature 914 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature [K] 908 915 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness 909 916 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness … … 959 966 ! ----------------------------! 960 967 961 ! ... turbulent heat fluxes with Ch_ atmrecalculated in blk_ice_1968 ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 962 969 ! Sensible Heat 963 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj))970 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 964 971 ! Latent Heat 965 972 zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 966 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * Ce_ atm(ji,jj) * wndm_ice(ji,jj) * &973 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * Ce_ice(ji,jj) * wndm_ice(ji,jj) * & 967 974 & ( 11637800. * zztmp2 / zrhoa(ji,jj) - phumi(ji,jj) ) ) 968 975 ! Latent heat sensitivity for ice (Dqla/Dt) 969 976 IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 970 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ atm(ji,jj) * wndm_ice(ji,jj) * &977 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) * & 971 978 & z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 972 979 ELSE … … 975 982 976 983 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 977 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ atm(ji,jj) * wndm_ice(ji,jj)984 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ice(ji,jj) * wndm_ice(ji,jj) 978 985 979 986 ! ----------------------------! … … 1151 1158 1152 1159 1153 SUBROUTINE Cdn10_Lupkes2012( Cd )1160 SUBROUTINE Cdn10_Lupkes2012( pcd ) 1154 1161 !!---------------------------------------------------------------------- 1155 1162 !! *** ROUTINE Cdn10_Lupkes2012 *** … … 1181 1188 !! 1182 1189 !!---------------------------------------------------------------------- 1183 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Cd1190 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pcd 1184 1191 REAL(wp), PARAMETER :: zCe = 2.23e-03_wp 1185 1192 REAL(wp), PARAMETER :: znu = 1._wp … … 1196 1203 1197 1204 ! ice-atm drag 1198 Cd(:,:) = Cd_ice + & ! pure ice drag1199 & zCe* ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp) ! change due to sea-ice morphology1205 pcd(:,:) = rcdice + & ! pure ice drag 1206 & zCe * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp) ! change due to sea-ice morphology 1200 1207 1201 1208 END SUBROUTINE Cdn10_Lupkes2012 1202 1209 1203 1210 1204 SUBROUTINE Cdn10_Lupkes2015( Cd, Ch )1211 SUBROUTINE Cdn10_Lupkes2015( ptm_su, pcd, pch ) 1205 1212 !!---------------------------------------------------------------------- 1206 1213 !! *** ROUTINE Cdn10_Lupkes2015 *** … … 1223 1230 !!---------------------------------------------------------------------- 1224 1231 ! 1225 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Cd 1226 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Ch 1227 REAL(wp), DIMENSION(jpi,jpj) :: ztm_su, zst, zqo_sat, zqi_sat 1232 REAL(wp), DIMENSION(:,:), INTENT(in ) :: ptm_su ! sea-ice surface temperature [K] 1233 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pcd ! momentum transfert coefficient 1234 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pch ! heat transfert coefficient 1235 REAL(wp), DIMENSION(jpi,jpj) :: zst, zqo_sat, zqi_sat 1228 1236 ! 1229 1237 ! ECHAM6 constants … … 1252 1260 REAL(wp) :: zCdn_form_tmp 1253 1261 !!--------------------------------------------------------------------------- 1254 ! fl: global variable tm_su could be used directly instead of recomputing it 1255 ! 1256 ! mean temperature 1257 WHERE( at_i_b(:,:) > 1.e-20 ) ; ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:) 1258 ELSEWHERE ; ztm_su(:,:) = rt0 1259 ENDWHERE 1260 1262 ! 1261 1263 ! Momentum Neutral Transfert Coefficients (should be a constant) 1262 1264 zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2 ! Eq. 40 1263 1265 zCdn_skin_ice = ( vkarmn / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2 ! Eq. 7 1264 zCdn_ice = zCdn_skin_ice ! Eq. 7 (cf Lupkes email for details)1266 zCdn_ice = zCdn_skin_ice ! Eq. 7 1265 1267 !zCdn_ice = 1.89e-3 ! old ECHAM5 value (cf Eq. 32) 1266 1268 1267 1269 ! Heat Neutral Transfert Coefficients 1268 zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) ) ! Eq. 50 + Eq. 52 (cf Lupkes email for details)1270 zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) ) ! Eq. 50 + Eq. 52 1269 1271 1270 1272 ! Atmospheric and Surface Variables 1271 1273 zst(:,:) = sst_m(:,:) + rt0 ! convert SST from Celcius to Kelvin 1272 1274 zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:) , sf(jp_slp)%fnow(:,:,1) ) ! saturation humidity over ocean [kg/kg] 1273 zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) ) ! saturation humidity over ice [kg/kg]1274 ! 1275 DO jj = 2, jpjm1 ! reduced loop is necessary for reproduc ibility1275 zqi_sat(:,:) = 0.98_wp * q_sat( ptm_su(:,:), sf(jp_slp)%fnow(:,:,1) ) ! saturation humidity over ice [kg/kg] 1276 ! 1277 DO jj = 2, jpjm1 ! reduced loop is necessary for reproductibility 1276 1278 DO ji = fs_2, fs_jpim1 1277 1279 ! Virtual potential temperature [K] 1278 1280 zthetav_os = zst(ji,jj) * ( 1._wp + rctv0 * zqo_sat(ji,jj) ) ! over ocean 1279 zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) ) ! ocean ice1281 zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) ) ! ocean ice 1280 1282 zthetav_zu = t_zu (ji,jj) * ( 1._wp + rctv0 * q_zu(ji,jj) ) ! at zu 1281 1283 … … 1290 1292 ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 1291 1293 z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 1292 z0i = z0_skin_ice ! over ice (cf Lupkes email for details)1294 z0i = z0_skin_ice ! over ice 1293 1295 IF( zrib_o <= 0._wp ) THEN 1294 1296 zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) ) ! Eq. 10 … … 1309 1311 1310 1312 ! Momentum Transfert Coefficients (Eq. 38) 1311 Cd(ji,jj) = zCdn_skin_ice * zfmi + &1312 & zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )1313 pcd(ji,jj) = zCdn_skin_ice * zfmi + & 1314 & zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 1313 1315 1314 1316 ! Heat Transfert Coefficients (Eq. 49) 1315 Ch(ji,jj) = zChn_skin_ice * zfhi + &1316 & zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) )1317 pch(ji,jj) = zChn_skin_ice * zfhi + & 1318 & zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 1317 1319 ! 1318 1320 END DO 1319 1321 END DO 1320 CALL lbc_lnk_multi( 'sbcblk', Cd, 'T', 1., Ch, 'T', 1. ) 1322 ! 1323 CALL lbc_lnk_multi( 'sbcblk', pcd, 'T', 1., pch, 'T', 1. ) 1321 1324 ! 1322 1325 END SUBROUTINE Cdn10_Lupkes2015
Note: See TracChangeset
for help on using the changeset viewer.
