Changeset 70 for trunk/NEMO/LIM_SRC
- Timestamp:
- 2004-04-22T14:19:29+02:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC/limthd.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC/limthd.F90
r3 r70 16 16 USE lbclnk 17 17 USE in_out_manager ! I/O manager 18 19 18 USE ice ! LIM sea-ice variables 20 19 USE ice_oce ! sea-ice/ocean variables … … 33 32 PUBLIC lim_thd ! called by lim_step 34 33 35 !! * Module variables 36 REAL(wp) :: & ! constant values 37 epsi20 = 1e-20 , & 38 epsi16 = 1e-16 , & 39 epsi04 = 1e-04 , & 40 zzero = 0.0 , & 41 zone = 1.0 34 !! * Module variables 35 REAL(wp) :: & ! constant values 36 epsi20 = 1.e-20 , & 37 epsi16 = 1.e-16 , & 38 epsi04 = 1.e-04 , & 39 zzero = 0.e0 , & 40 zone = 1.e0 41 42 42 !! * Substitutions 43 # include "domzgr_substitute.h90" 43 44 # include "vectopt_loop_substitute.h90" 44 45 !!-------- ------------------------------------------------------------- … … 63 64 !! - call lim_lat_acc for the ice accretion 64 65 !! - back to the geographic grid 65 !!66 66 !! 67 67 !! ** References : … … 76 76 nbpb , & ! nb of icy pts for thermo. cal. 77 77 nbpac ! nb of pts for lateral accretion 78 79 78 REAL(wp) :: & 80 79 zfric_umin = 5e-03 , & ! lower bound for the friction velocity 81 80 zfric_umax = 2e-02 ! upper bound for the friction velocity 82 83 81 REAL(wp) :: & 84 82 zinda , & ! switch for test. the val. of concen. … … 89 87 zfontn , & ! heat flux from snow thickness 90 88 zfntlat, zpareff ! test. the val. of lead heat budget 91 92 89 REAL(wp), DIMENSION(jpi,jpj) :: & 93 90 zhicifp , & ! ice thickness for outputs … … 102 99 103 100 !i est-ce utile? oui au moins en partie 104 rdvosif(:,:) = 0. 0 ! variation of ice volume at surface105 rdvobif(:,:) = 0. 0 ! variation of ice volume at bottom106 fdvolif(:,:) = 0. 0 ! total variation of ice volume107 rdvonif(:,:) = 0. 0 ! lateral variation of ice volume108 fstric (:,:) = 0. 0 ! part of solar radiation absorbing inside the ice109 fscmbq (:,:) = 0. 0 ! linked with fstric110 ffltbif(:,:) = 0. 0 ! linked with fstric111 qfvbq (:,:) = 0. 0 ! linked with fstric112 rdmsnif(:,:) = 0. 0 ! variation of snow mass per unit area113 rdmicif(:,:) = 0. 0 ! variation of ice mass per unit area114 hicifp (:,:) = 0. 0 ! daily thermodynamic ice production.101 rdvosif(:,:) = 0.e0 ! variation of ice volume at surface 102 rdvobif(:,:) = 0.e0 ! variation of ice volume at bottom 103 fdvolif(:,:) = 0.e0 ! total variation of ice volume 104 rdvonif(:,:) = 0.e0 ! lateral variation of ice volume 105 fstric (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice 106 fscmbq (:,:) = 0.e0 ! linked with fstric 107 ffltbif(:,:) = 0.e0 ! linked with fstric 108 qfvbq (:,:) = 0.e0 ! linked with fstric 109 rdmsnif(:,:) = 0.e0 ! variation of snow mass per unit area 110 rdmicif(:,:) = 0.e0 ! variation of ice mass per unit area 111 hicifp (:,:) = 0.e0 ! daily thermodynamic ice production. 115 112 116 113 DO jj = 1, jpj … … 119 116 END DO 120 117 END DO 121 IF( l_ctl .AND. lwp) WRITE(numout,*) 'lim_thd : ', SUM( hsnif(:,:) ) , ' hsnif'118 IF(l_ctl) WRITE(numout,*) 'lim_thd : ', SUM( hsnif(:,:) ) , ' hsnif' 122 119 123 120 … … 151 148 END DO 152 149 END DO 153 IF( l_ctl .AND. lwp) THEN150 IF(l_ctl) THEN 154 151 WRITE(numout,*) 'lim_thd: hicif : ', SUM( hicif ), ' hsnif ', SUM( hsnif ) 155 152 WRITE(numout,*) 'lim_thd: dmgwi : ', SUM( dmgwi ), ' qstoif ', SUM( qstoif ) … … 175 172 176 173 ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 177 thcm(ji,jj) = 0. 0174 thcm(ji,jj) = 0.e0 178 175 179 176 ! net downward heat flux from the ice to the ocean, expressed as a function of ocean … … 198 195 199 196 ! energy needed to bring ocean surface layer until its freezing 200 qcmif (ji,jj) = rau0 * rcp * dz* ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda )197 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda ) 201 198 202 199 ! calculate oceanic heat flux. … … 220 217 END DO 221 218 END DO 222 IF( l_ctl .AND. lwp) THEN219 IF(l_ctl) THEN 223 220 WRITE(numout,*) 'lim_thd: pfrld ', SUM( pfrld ), ' thcm ', SUM( thcm ) 224 221 WRITE(numout,*) 'lim_thd: fdtcn ', SUM( fdtcn ), ' qdtcn ', SUM( qdtcn ) … … 261 258 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb) , zqlbsbq , jpi, jpj, npb(1:nbpb) ) 262 259 263 264 265 ! call the ice growth routine. 266 CALL lim_thd_zdf( 1, nbpb ) 260 CALL lim_thd_zdf( 1, nbpb ) ! compute ice growth 267 261 268 262 ! back to the geographic grid. … … 304 298 ! Tricky trick : add 2 to frld in the Southern Hemisphere. 305 299 !---------------------------------------------------------- 306 DO jj = 1, jeqm1 !ibug in mpp300 DO jj = 1, njeqm1 !ibug in mpp 307 301 DO ji = 1, jpi 308 302 frld(ji,jj) = frld(ji,jj) + 2.0 … … 317 311 DO jj = 1, jpj 318 312 DO ji = 1, jpi 319 !i yes! IF ( ( qcmif(ji,jj) - qldif(ji,jj) ) > 0. 0 ) THEN320 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0. 0 ) THEN313 !i yes! IF ( ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 314 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 321 315 nbpac = nbpac + 1 322 316 npac( nbpac ) = (jj - 1) * jpi + ji … … 325 319 END DO 326 320 327 IF( l_ctl .AND. lwp) THEN321 IF(l_ctl) THEN 328 322 WRITE(numout,*) 'lim_thd : phicif ', SUM( phicif ), ' hicif ', SUM( hicif ) 329 323 WRITE(numout,*) 'lim_thd : nbpac = ', nbpac … … 335 329 !-------------------------------------------------------------------------------- 336 330 337 IF 331 IF( nbpac > 0 ) THEN 338 332 339 333 !...Put the variable in a 1-D array for lateral accretion 340 CALL tab_2d_1d( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) )341 CALL tab_2d_1d( nbpac, h_snow_1d (1:nbpac) , hsnif , jpi, jpj, npac(1:nbpac) )342 CALL tab_2d_1d( nbpac, h_ice_1d (1:nbpac) , hicif , jpi, jpj, npac(1:nbpac) )343 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 1 ), tbif(:,:,1), jpi, jpj, npac(1:nbpac) )344 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 2 ), tbif(:,:,2), jpi, jpj, npac(1:nbpac) )345 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 3 ), tbif(:,:,3), jpi, jpj, npac(1:nbpac) )346 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) )347 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) )348 CALL tab_2d_1d( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) )349 CALL tab_2d_1d( nbpac, rdmicif_1d(1:nbpac) , rdmicif , jpi, jpj, npac(1:nbpac) )350 CALL tab_2d_1d( nbpac, dvlbq_1d (1:nbpac) , fdvolif , jpi, jpj, npac(1:nbpac) )351 CALL tab_2d_1d( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) )334 CALL tab_2d_1d( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) ) 335 CALL tab_2d_1d( nbpac, h_snow_1d (1:nbpac) , hsnif , jpi, jpj, npac(1:nbpac) ) 336 CALL tab_2d_1d( nbpac, h_ice_1d (1:nbpac) , hicif , jpi, jpj, npac(1:nbpac) ) 337 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 1 ), tbif(:,:,1), jpi, jpj, npac(1:nbpac) ) 338 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 2 ), tbif(:,:,2), jpi, jpj, npac(1:nbpac) ) 339 CALL tab_2d_1d( nbpac, tbif_1d (1:nbpac , 3 ), tbif(:,:,3), jpi, jpj, npac(1:nbpac) ) 340 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) 341 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 342 CALL tab_2d_1d( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) ) 343 CALL tab_2d_1d( nbpac, rdmicif_1d(1:nbpac) , rdmicif , jpi, jpj, npac(1:nbpac) ) 344 CALL tab_2d_1d( nbpac, dvlbq_1d (1:nbpac) , fdvolif , jpi, jpj, npac(1:nbpac) ) 345 CALL tab_2d_1d( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) ) 352 346 353 ! call lateral accretion routine. 354 CALL lim_thd_lac( 1 , nbpac ) 347 ! call lateral accretion routine. 348 CALL lim_thd_lac( 1 , nbpac ) 349 350 ! back to the geographic grid 351 CALL tab_1d_2d( nbpac, frld , npac(1:nbpac), frld_1d (1:nbpac) , jpi, jpj ) 352 CALL tab_1d_2d( nbpac, hsnif , npac(1:nbpac), h_snow_1d (1:nbpac) , jpi, jpj ) 353 CALL tab_1d_2d( nbpac, hicif , npac(1:nbpac), h_ice_1d (1:nbpac) , jpi, jpj ) 354 CALL tab_1d_2d( nbpac, tbif(:,:,1), npac(1:nbpac), tbif_1d (1:nbpac , 1 ), jpi, jpj ) 355 CALL tab_1d_2d( nbpac, tbif(:,:,2), npac(1:nbpac), tbif_1d (1:nbpac , 2 ), jpi, jpj ) 356 CALL tab_1d_2d( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d (1:nbpac , 3 ), jpi, jpj ) 357 CALL tab_1d_2d( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) 358 CALL tab_1d_2d( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d(1:nbpac) , jpi, jpj ) 359 CALL tab_1d_2d( nbpac, fdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) 355 360 356 ! back to the geographic grid 357 CALL tab_1d_2d( nbpac, frld , npac(1:nbpac), frld_1d (1:nbpac) , jpi, jpj ) 358 CALL tab_1d_2d( nbpac, hsnif , npac(1:nbpac), h_snow_1d (1:nbpac) , jpi, jpj ) 359 CALL tab_1d_2d( nbpac, hicif , npac(1:nbpac), h_ice_1d (1:nbpac) , jpi, jpj ) 360 CALL tab_1d_2d( nbpac, tbif(:,:,1), npac(1:nbpac), tbif_1d (1:nbpac , 1 ), jpi, jpj ) 361 CALL tab_1d_2d( nbpac, tbif(:,:,2), npac(1:nbpac), tbif_1d (1:nbpac , 2 ), jpi, jpj ) 362 CALL tab_1d_2d( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d (1:nbpac , 3 ), jpi, jpj ) 363 CALL tab_1d_2d( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) 364 CALL tab_1d_2d( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d(1:nbpac) , jpi, jpj ) 365 CALL tab_1d_2d( nbpac, fdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) 366 367 368 ENDIF 361 ENDIF 369 362 370 363 371 372 373 364 ! Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick) 365 ! Update daily thermodynamic ice production. 366 !------------------------------------------------------------------------------ 374 367 375 368 DO jj = 1, jpj … … 380 373 END DO 381 374 382 IF( l_ctl .AND. lwp) THEN375 IF(l_ctl) THEN 383 376 WRITE(numout,*) ' lim_thd end ' 384 377 WRITE(numout,*) ' hicif ', SUM( hicif ), ' hsnif ', SUM( hsnif ) … … 392 385 393 386 END SUBROUTINE lim_thd 387 394 388 395 389 SUBROUTINE lim_thd_init … … 418 412 REWIND( numnam_ice ) 419 413 READ ( numnam_ice , namicethd ) 420 IF 414 IF(lwp) THEN 421 415 WRITE(numout,*) 422 416 WRITE(numout,*)'lim_thd_init : ice parameters for ice thermodynamic computation ' 423 417 WRITE(numout,*)'~~~~~~~~~~~~' 424 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt425 WRITE(numout,*)' ice thick. for lateral accretion in NH (SH) hiccrit(1/2) = ', hiccrit426 WRITE(numout,*)' ice thick. corr. to max. energy stored in brine pocket hicmin = ', hicmin427 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim428 WRITE(numout,*)' maximum lead fraction amax = ', amax429 WRITE(numout,*)' energy stored in brine pocket (=1) or not (=0) swiqst = ', swiqst430 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice '431 WRITE(numout,*)' Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) sbeta = ', sbeta432 WRITE(numout,*)' percentage of energy used for lateral ablation parlat = ', parlat433 WRITE(numout,*)' slope of distr. for Hakkinen-Mellor lateral melting hakspl = ', hakspl434 WRITE(numout,*)' slope of distribution for Hibler lateral melting hibspl = ', hibspl435 WRITE(numout,*)' exponent for leads-closure rate exld = ', exld436 WRITE(numout,*)' coefficient for diffusions of ice and snow hakdif = ', hakdif437 WRITE(numout,*)' threshold thick. for comp. of eq. thermal conductivity zhth = ', thth438 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst439 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub440 WRITE(numout,*)' coefficient for snow density when snow ice formation alphs = ', alphs418 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt 419 WRITE(numout,*)' ice thick. for lateral accretion in NH (SH) hiccrit(1/2) = ', hiccrit 420 WRITE(numout,*)' ice thick. corr. to max. energy stored in brine pocket hicmin = ', hicmin 421 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim 422 WRITE(numout,*)' maximum lead fraction amax = ', amax 423 WRITE(numout,*)' energy stored in brine pocket (=1) or not (=0) swiqst = ', swiqst 424 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 425 WRITE(numout,*)' Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) sbeta = ', sbeta 426 WRITE(numout,*)' percentage of energy used for lateral ablation parlat = ', parlat 427 WRITE(numout,*)' slope of distr. for Hakkinen-Mellor lateral melting hakspl = ', hakspl 428 WRITE(numout,*)' slope of distribution for Hibler lateral melting hibspl = ', hibspl 429 WRITE(numout,*)' exponent for leads-closure rate exld = ', exld 430 WRITE(numout,*)' coefficient for diffusions of ice and snow hakdif = ', hakdif 431 WRITE(numout,*)' threshold thick. for comp. of eq. thermal conductivity zhth = ', thth 432 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst 433 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub 434 WRITE(numout,*)' coefficient for snow density when snow ice formation alphs = ', alphs 441 435 ENDIF 442 436 … … 445 439 rcdic = hakdif * rcdic 446 440 447 IF ( ( hsndif > 100. 0 ) .OR. ( hicdif > 100.0 ) ) THEN441 IF ( ( hsndif > 100.e0 ) .OR. ( hicdif > 100.e0 ) ) THEN 448 442 cnscg = 0.e0 449 443 ELSE … … 454 448 455 449 #else 456 !!====================================================================== 457 !! *** MODULE limthd *** 458 !! No sea ice model 459 !!====================================================================== 450 !!---------------------------------------------------------------------- 451 !! Default option Dummy module NO LIM sea-ice model 452 !!---------------------------------------------------------------------- 460 453 CONTAINS 461 SUBROUTINE lim_thd ! Empty routine454 SUBROUTINE lim_thd ! Dummy routine 462 455 END SUBROUTINE lim_thd 463 456 #endif
Note: See TracChangeset
for help on using the changeset viewer.
