Changeset 717 for trunk/NEMO/LIM_SRC/limthd.F90
- Timestamp:
- 2007-10-16T13:03:55+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC/limthd.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC/limthd.F90
r709 r717 4 4 !! LIM thermo ice model : ice thermodynamic 5 5 !!====================================================================== 6 !! History : 1.0 ! 00-01 (LIM) 7 !! 2.0 ! 02-07 (C. Ethe, G. Madec) F90 8 !! 2.0 ! 03-08 (C. Ethe) add lim_thd_init 9 !!--------------------------------------------------------------------- 6 10 #if defined key_ice_lim 7 11 !!---------------------------------------------------------------------- … … 11 15 !! lim_thd_init : initialisation of sea-ice thermodynamic 12 16 !!---------------------------------------------------------------------- 13 !! * Modules used17 USE phycst ! physical constants 14 18 USE dom_oce ! ocean space and time domain variables 15 USE sbc_oce ! surface boundary condition: ocean 19 USE lbclnk 20 USE in_out_manager ! I/O manager 21 USE ice ! LIM sea-ice variables 16 22 USE ice_oce ! sea-ice/ocean variables 23 USE sbc_oce ! 24 USE sbc_ice ! 17 25 USE thd_ice ! LIM thermodynamic sea-ice variables 18 26 USE dom_ice ! LIM sea-ice domain 19 USE ice ! LIM sea-ice variables20 27 USE iceini 21 28 USE limthd_zdf 22 29 USE limthd_lac 23 30 USE limtab 24 USE phycst ! physical constants25 USE in_out_manager ! I/O manager26 31 USE prtctl ! Print control 27 USE lbclnk28 32 29 33 IMPLICIT NONE 30 34 PRIVATE 31 35 32 !! * Routine accessibility 33 PUBLIC lim_thd ! called by lim_step 34 35 !! * Module variables 36 REAL(wp) :: & ! constant values 37 epsi20 = 1.e-20 , & 38 epsi16 = 1.e-16 , & 39 epsi04 = 1.e-04 , & 40 zzero = 0.e0 , & 41 zone = 1.e0 36 PUBLIC lim_thd ! called by lim_step 37 38 REAL(wp) :: epsi20 = 1.e-20 , & ! constant values 39 & epsi16 = 1.e-16 , & 40 & epsi04 = 1.e-04 , & 41 & zzero = 0.e0 , & 42 & zone = 1.e0 42 43 43 44 !! * Substitutions … … 47 48 !! LIM 2.0, UCL-LOCEAN-IPSL (2005) 48 49 !! $Id$ 49 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 50 51 !!---------------------------------------------------------------------- 51 52 … … 68 69 !! - back to the geographic grid 69 70 !! 70 !! ** References : 71 !! H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 72 !! 73 !! History : 74 !! 1.0 ! 00-01 (LIM) 75 !! 2.0 ! 02-07 (C. Ethe, G. Madec) F90 71 !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 76 72 !!--------------------------------------------------------------------- 77 73 INTEGER, INTENT(in) :: kt ! number of iteration 78 74 !! 79 75 INTEGER :: ji, jj, & ! dummy loop indices 80 76 nbpb , & ! nb of icy pts for thermo. cal. … … 92 88 zfontn , & ! heat flux from snow thickness 93 89 zfntlat, zpareff ! test. the val. of lead heat budget 94 REAL(wp), DIMENSION(jpi,jpj) :: & 95 zhicifp , & ! ice thickness for outputs 96 zqlbsbq ! link with lead energy budget qldif 97 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 98 zmsk ! working array 90 REAL(wp), DIMENSION(jpi,jpj) :: zhicifp, & ! ice thickness for outputs 91 & zqlbsbq ! link with lead energy budget qldif 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! working array 99 93 !!------------------------------------------------------------------- 100 94 101 IF( kt == nit000 95 IF( kt == nit000 ) CALL lim_thd_init ! Initialization (first time-step only) 102 96 103 97 !-------------------------------------------! … … 188 182 ! temperature and turbulent mixing (McPhee, 1992) 189 183 zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) ! friction velocity 190 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_io(ji,jj) - tfu(ji,jj) ) 184 !!gm old fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_io(ji,jj) - tfu(ji,jj) ) 185 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) ) 191 186 qdtcn(ji,jj) = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice 192 187 193 188 ! partial computation of the lead energy budget (qldif) 194 189 zfontn = ( sprecip(ji,jj) / rhosn ) * xlsn ! energy for melting 195 zfnsol = qns r_oce(ji,jj) ! total non solar flux196 qldif(ji,jj) = tms(ji,jj) * ( qsr _oce(ji,jj) * ( 1.0 - thcm(ji,jj) ) &190 zfnsol = qns(ji,jj) ! total non solar flux over the ocean 191 qldif(ji,jj) = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 197 192 & + zfnsol + fdtcn(ji,jj) - zfontn & 198 193 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) & … … 206 201 207 202 ! energy needed to bring ocean surface layer until its freezing 208 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda ) 203 !!gm old qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda ) 204 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda ) 209 205 210 206 ! calculate oceanic heat flux. … … 258 254 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) 259 255 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) 260 CALL tab_2d_1d( nbpb, qns r_ice_1d(1:nbpb) , qnsr_ice, jpi, jpj, npb(1:nbpb) )256 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb) , qns_ice , jpi, jpj, npb(1:nbpb) ) 261 257 #if ! defined key_coupled 262 258 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb) , qla_ice , jpi, jpj, npb(1:nbpb) ) … … 394 390 IF(ln_ctl) THEN 395 391 CALL prt_ctl_info(' lim_thd end ') 396 CALL prt_ctl(tab2d_1=hicif , clinfo1=' lim_thd: hicif : ', tab2d_2=hsnif , clinfo2=' hsnif : ') 397 CALL prt_ctl(tab2d_1=frld , clinfo1=' lim_thd: frld : ', tab2d_2=hicifp, clinfo2=' hicifp : ') 398 CALL prt_ctl(tab2d_1=phicif, clinfo1=' lim_thd: phicif : ', tab2d_2=pfrld , clinfo2=' pfrld : ') 399 CALL prt_ctl(tab2d_1=sist , clinfo1=' lim_thd: sist : ') 400 CALL prt_ctl(tab2d_1=tbif(:,:,1), clinfo1=' lim_thd: tbif 1 : ') 401 CALL prt_ctl(tab2d_1=tbif(:,:,2), clinfo1=' lim_thd: tbif 2 : ') 402 CALL prt_ctl(tab2d_1=tbif(:,:,3), clinfo1=' lim_thd: tbif 3 : ') 403 CALL prt_ctl(tab2d_1=fdtcn , clinfo1=' lim_thd: fdtcn : ', tab2d_2=qdtcn , clinfo2=' qdtcn : ') 404 CALL prt_ctl(tab2d_1=qstoif, clinfo1=' lim_thd: qstoif : ', tab2d_2=fsbbq , clinfo2=' fsbbq : ') 405 ENDIF 406 407 END SUBROUTINE lim_thd 408 409 410 SUBROUTINE lim_thd_init 392 CALL prt_ctl(tab2d_1=hicif , clinfo1=' hicif : ', tab2d_2=hsnif , clinfo2=' hsnif : ') 393 CALL prt_ctl(tab2d_1=frld , clinfo1=' frld : ', tab2d_2=hicifp , clinfo2=' hicifp : ') 394 CALL prt_ctl(tab2d_1=phicif , clinfo1=' phicif : ', tab2d_2=pfrld , clinfo2=' pfrld : ') 395 CALL prt_ctl(tab2d_1=sist , clinfo1=' sist : ', tab2d_2=tbif(:,:,1), clinfo2=' tbif 1 : ') 396 CALL prt_ctl(tab2d_1=tbif(:,:,2), clinfo1=' tbif 2 : ', tab2d_2=tbif(:,:,3), clinfo2=' tbif 3 : ') 397 CALL prt_ctl(tab2d_1=fdtcn , clinfo1=' fdtcn : ', tab2d_2=qdtcn , clinfo2=' qdtcn : ') 398 CALL prt_ctl(tab2d_1=qstoif , clinfo1=' qstoif : ', tab2d_2=fsbbq , clinfo2=' fsbbq : ') 399 ENDIF 400 ! 401 END SUBROUTINE lim_thd 402 403 404 SUBROUTINE lim_thd_init 411 405 !!------------------------------------------------------------------- 412 406 !! *** ROUTINE lim_thd_init *** … … 419 413 !! 420 414 !! ** input : Namelist namicether 421 !!422 !! history :423 !! 8.5 ! 03-08 (C. Ethe) original code424 415 !!------------------------------------------------------------------- 425 416 NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax , &
Note: See TracChangeset
for help on using the changeset viewer.
