- Timestamp:
- 2017-11-24T17:56:51+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/iceistate.F90
r8637 r8813 48 48 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 49 49 ! 50 ! ** namelist (namini) **50 ! !! ** namelist (namini) ** 51 51 LOGICAL :: ln_iceini ! initialization or not 52 52 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file … … 91 91 !! where there is no ice (clem: I do not know why, is it mandatory?) 92 92 !!-------------------------------------------------------------------- 93 INTEGER :: ji, jj, jk, jl ! dummy loop indices 93 INTEGER :: ji, jj, jk, jl ! dummy loop indices 94 INTEGER :: i_hemis, i_fill, jl0 ! local integers 94 95 REAL(wp) :: ztmelts, zdh 95 INTEGER :: i_hemis, i_fill, jl096 96 REAL(wp) :: zarg, zV, zconv, zdv, zfac 97 97 INTEGER , DIMENSION(4) :: itest … … 100 100 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 101 101 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 102 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini , za_i_ini!data by cattegories to fill102 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini , za_i_ini !data by cattegories to fill 103 103 !-------------------------------------------------------------------- 104 104 … … 116 116 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 117 117 END DO 118 119 ! init basal temperature (considered at freezing point) 118 ! 119 ! init basal temperature (considered at freezing point) [Kelvin] 120 120 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 121 121 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) … … 142 142 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 143 143 ! 144 !!---------------!144 ! !---------------! 145 145 ELSE ! Read namelist ! 146 146 ! !---------------! 147 148 ! no ice if sst <= t-freez + ttest 149 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 150 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 147 ! no ice if sst <= t-freez + ttest 148 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 149 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 151 150 END WHERE 152 151 ! 153 152 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 154 153 WHERE( ff_t(:,:) >= 0._wp ) … … 242 241 ! 243 242 ENDIF 244 243 ! 245 244 ! Compatibility tests 246 245 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) ! Test 1: area conservation 247 246 IF ( zconv < epsi06 ) itest(1) = 1 248 247 ! 249 248 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & ! Test 2: volume conservation 250 249 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 251 250 IF ( zconv < epsi06 ) itest(2) = 1 252 251 ! 253 252 IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 ! Test 3: thickness of the last category is in-bounds ? 254 253 ! 255 254 itest(4) = 1 256 255 DO jl = 1, i_fill … … 260 259 END DO ! end iteration on categories 261 260 ! !---------------------------- 262 !263 261 IF( lwp .AND. SUM(itest) /= 4 ) THEN 264 262 WRITE(numout,*) … … 270 268 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 271 269 ENDIF 272 270 ! 273 271 ENDIF 274 272 ! … … 279 277 ! 4) Fill in sea ice arrays 280 278 !--------------------------------------------------------------------- 281 279 ! 282 280 ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 283 281 DO jl = 1, jpl ! loop over categories … … 289 287 o_i(ji,jj,jl) = 0._wp ! age (0 day) 290 288 t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 291 289 ! 292 290 IF( zht_i_ini(ji,jj) > 0._wp )THEN 293 291 h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) ) ! snow depth … … 295 293 h_s(ji,jj,jl)= 0._wp 296 294 ENDIF 297 295 ! 298 296 ! This case below should not be used if (h_s/h_i) is ok in namelist 299 297 ! In case snow load is in excess that would lead to transformation from snow to ice … … 303 301 h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 304 302 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 305 303 ! 306 304 ! ice volume, salt content, age content 307 305 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) ! ice volume … … 312 310 END DO 313 311 END DO 314 315 ! for constant salinity in time 316 IF( nn_icesal /= 2 ) THEN 312 ! 313 IF( nn_icesal /= 2 ) THEN ! for constant salinity in time 317 314 CALL ice_var_salprof 318 315 sv_i = s_i * v_i 319 316 ENDIF 320 317 ! 321 318 ! Snow temperature and heat content 322 319 DO jk = 1, nlay_s … … 327 324 ! Snow energy of melting 328 325 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 329 326 ! 330 327 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 331 328 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s … … 334 331 END DO 335 332 END DO 336 333 ! 337 334 ! Ice salinity, temperature and heat content 338 335 DO jk = 1, nlay_i … … 343 340 sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin 344 341 ztmelts = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 345 342 ! 346 343 ! heat content per unit volume 347 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &348 + lfus * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) )&349 - rcp* ( ztmelts - rt0 ) )350 344 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 345 & + lfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 ) ) & 346 & - rcp * ( ztmelts - rt0 ) ) 347 ! 351 348 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 352 349 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i … … 355 352 END DO 356 353 END DO 357 354 ! 358 355 tn_ice (:,:,:) = t_su (:,:,:) 359 356 ! 360 357 ! Melt pond volume and fraction 361 358 IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN ; zfac = 1._wp … … 368 365 a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:) 369 366 v_ip(:,:,:) = h_ip (:,:,:) * a_ip(:,:,:) 370 367 ! 371 368 ELSE ! if ln_iceini=false 372 369 a_i (:,:,:) = 0._wp … … 379 376 s_i (:,:,:) = 0._wp 380 377 o_i (:,:,:) = 0._wp 381 378 ! 382 379 e_i(:,:,:,:) = 0._wp 383 380 e_s(:,:,:,:) = 0._wp 384 381 ! 385 382 DO jl = 1, jpl 386 383 DO jk = 1, nlay_i … … 391 388 END DO 392 389 END DO 393 390 ! 394 391 a_ip(:,:,:) = 0._wp 395 392 v_ip(:,:,:) = 0._wp 396 393 a_ip_frac(:,:,:) = 0._wp 397 394 h_ip (:,:,:) = 0._wp 398 395 ! 399 396 ENDIF ! ln_iceini 400 397 ! 401 398 at_i (:,:) = 0.0_wp 402 399 DO jl = 1, jpl … … 405 402 ! 406 403 ! --- set ice velocities --- ! 407 u_ice (:,:) 408 v_ice (:,:) 404 u_ice (:,:) = 0._wp 405 v_ice (:,:) = 0._wp 409 406 ! 410 407 !---------------------------------------------- … … 415 412 ! 416 413 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 417 414 ! 418 415 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 419 416 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 420 417 ! 421 418 IF( .NOT.ln_linssh ) THEN 422 419 ! 423 420 WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:) 424 421 ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 425 422 ! 426 423 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 427 424 e3t_n(:,:,jk) = e3t_0(:,:,jk) * z2d(:,:) … … 429 426 e3t_a(:,:,jk) = e3t_n(:,:,jk) 430 427 END DO 431 428 ! 432 429 ! Reconstruction of all vertical scale factors at now and before time-steps 433 430 ! ========================================================================= … … 478 475 !! CALL dia_wri_state( 'output.init', nit000 ) 479 476 !!! 480 477 ! 481 478 END SUBROUTINE ice_istate 479 482 480 483 481 SUBROUTINE ice_istate_init … … 485 483 !! *** ROUTINE ice_istate_init *** 486 484 !! 487 !! ** Purpose : Definition of initial state of the ice 488 !! 489 !! ** Method : Read the namini namelist and check the parameter 490 !! values called at the first timestep (nit000) 491 !! 492 !! ** input : 493 !! Namelist namini 494 !! 495 !! history : 496 !! 8.5 ! 03-08 (C. Ethe) original code 497 !! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization 485 !! ** Purpose : Definition of initial state of the ice 486 !! 487 !! ** Method : Read the namini namelist and check the parameter 488 !! values called at the first timestep (nit000) 489 !! 490 !! ** input : Namelist namini 491 !! 498 492 !!----------------------------------------------------------------------------- 499 ! 500 INTEGER :: ios,ierr,inum_ice ! Local integer output status for namelist read 501 INTEGER :: ji,jj 502 INTEGER :: ifpr, ierror 493 INTEGER :: ji, jj 494 INTEGER :: ios, ierr, inum_ice ! Local integer output status for namelist read 495 INTEGER :: ifpr, ierror 503 496 ! 504 497 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files … … 515 508 READ ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 516 509 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 517 510 ! 518 511 REWIND( numnam_ice_cfg ) ! Namelist namini in configuration namelist : Ice initial state 519 512 READ ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 520 513 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 521 514 IF(lwm) WRITE ( numoni, namini ) 522 515 ! 523 516 slf_i(jp_hti) = sn_hti ; slf_i(jp_hts) = sn_hts 524 517 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu … … 545 538 WRITE(numout,*) ' initial ice/snw temp in the south rn_tmi_ini_s = ', rn_tmi_ini_s 546 539 ENDIF 547 540 ! 548 541 IF( ln_iceini_file ) THEN ! Ice initialization using input file 549 542 ! … … 553 546 CALL ctl_stop( 'Ice_ini in iceistate: unable to allocate si structure' ) ; RETURN 554 547 ENDIF 555 548 ! 556 549 DO ifpr = 1, jpfldi 557 550 ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) 558 551 ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 559 552 END DO 560 553 ! 561 554 ! fill si with slf_i and control print 562 555 CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' ) 563 556 ! 564 557 CALL fld_read( nit000, 1, si ) ! input fields provided at the current time-step 565 558 ! 566 559 ENDIF 567 560 ! 568 561 END SUBROUTINE ice_istate_init 569 562
Note: See TracChangeset
for help on using the changeset viewer.
