Changeset 888 for trunk/NEMO/LIM_SRC_2/limthd_2.F90
- Timestamp:
- 2008-04-11T19:05:03+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_2/limthd_2.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_2/limthd_2.F90
r823 r888 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_lim2 7 11 !!---------------------------------------------------------------------- … … 18 22 USE ice_2 ! LIM sea-ice variables 19 23 USE ice_oce ! sea-ice/ocean variables 20 USE flx_oce ! sea-ice/ocean forcings variables 24 USE sbc_oce ! 25 USE sbc_ice ! 21 26 USE thd_ice_2 ! LIM thermodynamic sea-ice variables 22 27 USE dom_ice_2 ! LIM sea-ice domain … … 30 35 PRIVATE 31 36 32 !! * Routine accessibility 33 PUBLIC lim_thd_2 ! called by lim_step_2 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 37 PUBLIC lim_thd_2 ! called by lim_step 38 39 REAL(wp) :: epsi20 = 1.e-20 , & ! constant values 40 & epsi16 = 1.e-16 , & 41 & epsi04 = 1.e-04 , & 42 & zzero = 0.e0 , & 43 & zone = 1.e0 42 44 43 45 !! * Substitutions … … 46 48 !!-------- ------------------------------------------------------------- 47 49 !! LIM 2.0, UCL-LOCEAN-IPSL (2005) 48 !! $ Header$49 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt50 !! $ Id: $ 51 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 50 52 !!---------------------------------------------------------------------- 51 53 … … 68 70 !! - back to the geographic grid 69 71 !! 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 72 !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 76 73 !!--------------------------------------------------------------------- 77 74 INTEGER, INTENT(in) :: kt ! number of iteration 78 75 !! 79 76 INTEGER :: ji, jj, & ! dummy loop indices 80 77 nbpb , & ! nb of icy pts for thermo. cal. … … 92 89 zfontn , & ! heat flux from snow thickness 93 90 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 91 REAL(wp), DIMENSION(jpi,jpj) :: zhicifp, & ! ice thickness for outputs 92 & zqlbsbq ! link with lead energy budget qldif 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! working array 99 94 !!------------------------------------------------------------------- 100 95 101 IF( kt == nit000 96 IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) 102 97 103 98 !-------------------------------------------! … … 173 168 !-------------------------------------------------------------------------- 174 169 170 sst_m(:,:) = sst_m(:,:) + rt0 171 175 172 !CDIR NOVERRCHK 176 173 DO jj = 1, jpj … … 188 185 ! temperature and turbulent mixing (McPhee, 1992) 189 186 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) )187 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) ) 191 188 qdtcn(ji,jj) = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice 192 189 193 190 ! partial computation of the lead energy budget (qldif) 194 191 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) ) &192 zfnsol = qns(ji,jj) ! total non solar flux over the ocean 193 qldif(ji,jj) = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & 197 194 & + zfnsol + fdtcn(ji,jj) - zfontn & 198 195 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) & … … 206 203 207 204 ! 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 )205 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda ) 209 206 210 207 ! calculate oceanic heat flux. … … 216 213 END DO 217 214 215 sst_m(:,:) = sst_m(:,:) - rt0 218 216 219 217 ! Select icy points and fulfill arrays for the vectorial grid. … … 258 256 CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) 259 257 CALL tab_2d_1d_2( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) 260 CALL tab_2d_1d_2( nbpb, qns r_ice_1d(1:nbpb) , qnsr_ice, jpi, jpj, npb(1:nbpb) )258 CALL tab_2d_1d_2( nbpb, qns_ice_1d (1:nbpb) , qns_ice , jpi, jpj, npb(1:nbpb) ) 261 259 #if ! defined key_coupled 262 260 CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice , jpi, jpj, npb(1:nbpb) ) … … 404 402 CALL prt_ctl(tab2d_1=qstoif, clinfo1=' lim_thd: qstoif : ', tab2d_2=fsbbq , clinfo2=' fsbbq : ') 405 403 ENDIF 406 404 ! 407 405 END SUBROUTINE lim_thd_2 408 406 … … 419 417 !! 420 418 !! ** input : Namelist namicether 421 !!422 !! history :423 !! 8.5 ! 03-08 (C. Ethe) original code424 419 !!------------------------------------------------------------------- 425 420 NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax , &
Note: See TracChangeset
for help on using the changeset viewer.
