Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r5260 r5989 29 29 PRIVATE 30 30 31 PUBLIC lim_thd_dh ! called by lim_thd 31 PUBLIC lim_thd_dh ! called by lim_thd 32 PUBLIC lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here 33 34 INTERFACE lim_thd_snwblow 35 MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d 36 END INTERFACE 32 37 33 38 !!---------------------------------------------------------------------- … … 71 76 REAL(wp) :: zfdum 72 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 73 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads 74 REAL(wp) :: zs_snic ! snow-ice salinity 78 REAL(wp) :: zs_snic ! snow-ice salinity 75 79 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 76 80 REAL(wp) :: zswi12 ! switch for computation of bottom salinity … … 103 107 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2) 104 108 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 109 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing 105 110 106 111 REAL(wp) :: zswitch_sal … … 117 122 END SELECT 118 123 119 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema )124 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 120 125 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 121 126 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 122 127 CALL wrk_alloc( jpij, nlay_i, icount ) 123 128 124 129 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp 125 130 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp 126 127 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp 128 zq_rema(:) = 0._wp 129 130 zdh_s_pre(:) = 0._wp 131 zdh_s_mel(:) = 0._wp 132 zdh_s_sub(:) = 0._wp 133 zqh_s (:) = 0._wp 134 zqh_i (:) = 0._wp 135 136 zh_i (:,:) = 0._wp 137 zdeltah (:,:) = 0._wp 138 icount (:,:) = 0 131 132 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp 133 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp 134 zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp 135 zqh_s (:) = 0._wp ; zq_s (:) = 0._wp 136 137 zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp 138 icount (:,:) = 0 139 139 140 140 141 ! Initialize enthalpy at nlay_i+1 … … 218 219 ! Martin Vancoppenolle, December 2006 219 220 221 CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing 222 220 223 zdeltah(:,:) = 0._wp 221 224 DO ji = kideb, kiut … … 224 227 !----------- 225 228 ! thickness change 226 zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**rn_betas ) / at_i_1d(ji) 227 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice * r1_rhosn 228 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 229 zqprec (ji) = rhosn * ( cpic * ( rt0 - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 229 zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji) 230 ! enthalpy of the precip (>0, J.m-3) 231 zqprec (ji) = - qprec_ice_1d(ji) 230 232 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 231 233 ! heat flux from snow precip (>0, W.m-2) … … 280 282 ! clem comment: ice should also sublimate 281 283 zdeltah(:,:) = 0._wp 282 IF( lk_cpl ) THEN 283 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 284 zdh_s_sub(:) = 0._wp 285 ELSE 286 ! forced mode: snow thickness change due to sublimation 287 DO ji = kideb, kiut 288 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 289 ! Heat flux by sublimation [W.m-2], < 0 290 ! sublimate first snow that had fallen, then pre-existing snow 291 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 292 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & 293 & ) * a_i_1d(ji) * r1_rdtice 294 ! Mass flux by sublimation 295 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 296 ! new snow thickness 297 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 298 ! update precipitations after sublimation and correct sublimation 299 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 300 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 301 END DO 302 ENDIF 303 284 ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 285 ! forced mode: snow thickness change due to sublimation 286 DO ji = kideb, kiut 287 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 288 ! Heat flux by sublimation [W.m-2], < 0 289 ! sublimate first snow that had fallen, then pre-existing snow 290 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 291 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & 292 & ) * a_i_1d(ji) * r1_rdtice 293 ! Mass flux by sublimation 294 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 295 ! new snow thickness 296 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 297 ! update precipitations after sublimation and correct sublimation 298 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 299 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 300 END DO 301 304 302 ! --- Update snow diags --- ! 305 303 DO ji = kideb, kiut … … 688 686 WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 689 687 690 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema )688 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 691 689 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 692 690 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) … … 695 693 ! 696 694 END SUBROUTINE lim_thd_dh 695 696 697 !!-------------------------------------------------------------------------- 698 !! INTERFACE lim_thd_snwblow 699 !! ** Purpose : Compute distribution of precip over the ice 700 !!-------------------------------------------------------------------------- 701 SUBROUTINE lim_thd_snwblow_2d( pin, pout ) 702 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( pfrld or (1. - a_i_b) ) 703 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 704 pout = ( 1._wp - ( pin )**rn_betas ) 705 END SUBROUTINE lim_thd_snwblow_2d 706 707 SUBROUTINE lim_thd_snwblow_1d( pin, pout ) 708 REAL(wp), DIMENSION(:), INTENT(in ) :: pin 709 REAL(wp), DIMENSION(:), INTENT(inout) :: pout 710 pout = ( 1._wp - ( pin )**rn_betas ) 711 END SUBROUTINE lim_thd_snwblow_1d 712 697 713 698 714 #else
Note: See TracChangeset
for help on using the changeset viewer.