- Timestamp:
- 2020-03-21T15:40:52+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90
r12377 r12583 18 18 USE oce ! dynamics and tracers variables 19 19 USE dom_oce ! ocean domain 20 USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 20 USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 21 21 USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 22 22 USE eosbn2 ! equation of state … … 60 60 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 61 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 ! 62 ! 63 63 !! * Substitutions 64 64 # include "do_loop_substitute.h90" … … 77 77 !! 78 78 !! ** Method : This routine will put some ice where ocean 79 !! is at the freezing point, then fill in ice 80 !! state variables using prescribed initial 81 !! values in the namelist 79 !! is at the freezing point, then fill in ice 80 !! state variables using prescribed initial 81 !! values in the namelist 82 82 !! 83 83 !! ** Steps : 1) Set initial surface and basal temperatures … … 91 91 !! where there is no ice 92 92 !!-------------------------------------------------------------------- 93 INTEGER, INTENT(in) :: kt ! time step 93 INTEGER, INTENT(in) :: kt ! time step 94 94 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 95 95 ! … … 117 117 ! basal temperature (considered at freezing point) [Kelvin] 118 118 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 119 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 119 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 120 120 ! 121 121 ! surface temperature and conductivity … … 142 142 e_i (:,:,:,:) = 0._wp 143 143 e_s (:,:,:,:) = 0._wp 144 144 145 145 ! general fields 146 146 a_i (:,:,:) = 0._wp … … 215 215 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 216 216 & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 217 & * si(jp_ati)%fnow(:,:,1) 217 & * si(jp_ati)%fnow(:,:,1) 218 218 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 219 219 ! … … 224 224 ! 225 225 ! change the switch for the following 226 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 226 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 227 227 ELSEWHERE ; zswitch(:,:) = 0._wp 228 228 END WHERE … … 231 231 ! !---------------! 232 232 ! no ice if (sst - Tfreez) >= thresold 233 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 233 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 234 234 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 235 235 END WHERE … … 244 244 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 245 245 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 246 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 246 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 247 247 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 248 248 ELSEWHERE … … 265 265 zhpnd_ini(:,:) = 0._wp 266 266 ENDIF 267 267 268 268 !-------------! 269 269 ! fill fields ! … … 292 292 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 293 293 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 294 294 295 295 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 296 296 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & … … 338 338 DO jl = 1, jpl 339 339 DO_3D_11_11( 1, nlay_i ) 340 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 340 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 341 341 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 342 342 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & … … 354 354 END WHERE 355 355 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 356 356 357 357 ! specific temperatures for coupled runs 358 358 tn_ice(:,:,:) = t_su(:,:,:) … … 374 374 ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0 375 375 ! 376 IF( .NOT.ln_linssh ) THEN 377 ! 378 WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 379 ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 380 ! 381 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 382 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 383 e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 384 e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 385 END DO 386 ! 387 ! Reconstruction of all vertical scale factors at now and before time-steps 388 ! ========================================================================= 389 ! Horizontal scale factor interpolations 390 ! -------------------------------------- 391 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 392 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 393 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 394 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 395 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 396 ! Vertical scale factor interpolations 397 ! ------------------------------------ 398 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 399 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 400 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 401 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 402 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 403 ! t- and w- points depth 404 ! ---------------------- 405 !!gm not sure of that.... 406 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 407 gdepw(:,:,1,Kmm) = 0.0_wp 408 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 409 DO jk = 2, jpk 410 gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk ,Kmm) 411 gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 412 gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - ssh (:,:,Kmm) 413 END DO 414 ENDIF 376 IF( .NOT.ln_linssh ) CALL dom_vvl_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 377 ! !!st 378 ! IF( .NOT.ln_linssh ) THEN 379 ! ! 380 ! WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 381 ! ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 382 ! ! 383 ! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 384 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 385 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 386 ! e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 387 ! END DO 388 ! ! 389 ! ! Reconstruction of all vertical scale factors at now and before time-steps 390 ! ! ========================================================================= 391 ! ! Horizontal scale factor interpolations 392 ! ! -------------------------------------- 393 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 394 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 395 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 396 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 397 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 398 ! ! Vertical scale factor interpolations 399 ! ! ------------------------------------ 400 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 401 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 402 ! CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 403 ! CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 404 ! CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 405 ! ! t- and w- points depth 406 ! ! ---------------------- 407 ! !!gm not sure of that.... 408 ! gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 409 ! gdepw(:,:,1,Kmm) = 0.0_wp 410 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 411 ! DO jk = 2, jpk 412 ! gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk ,Kmm) 413 ! gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 414 ! gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - ssh (:,:,Kmm) 415 ! END DO 416 ! ENDIF 415 417 ENDIF 416 418 417 419 !------------------------------------ 418 420 ! 4) store fields at before time-step … … 429 431 v_ice_b(:,:) = v_ice(:,:) 430 432 ! total concentration is needed for Lupkes parameterizations 431 at_i_b (:,:) = at_i (:,:) 433 at_i_b (:,:) = at_i (:,:) 432 434 433 435 !!clem: output of initial state should be written here but it is impossible because … … 441 443 !!------------------------------------------------------------------- 442 444 !! *** ROUTINE ice_istate_init *** 443 !! 444 !! ** Purpose : Definition of initial state of the ice 445 !! 446 !! ** Method : Read the namini namelist and check the parameter 445 !! 446 !! ** Purpose : Definition of initial state of the ice 447 !! 448 !! ** Method : Read the namini namelist and check the parameter 447 449 !! values called at the first timestep (nit000) 448 450 !! … … 485 487 WRITE(numout,*) ' max ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 486 488 IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 487 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 489 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 488 490 WRITE(numout,*) ' initial ice thickness in the north-south rn_hti_ini = ', rn_hti_ini_n,rn_hti_ini_s 489 491 WRITE(numout,*) ' initial ice concentr in the north-south rn_ati_ini = ', rn_ati_ini_n,rn_ati_ini_s
Note: See TracChangeset
for help on using the changeset viewer.
