Changeset 11536 for NEMO/trunk/src/ICE
- Timestamp:
- 2019-09-11T15:54:18+02:00 (5 years ago)
- Location:
- NEMO/trunk/src/ICE
- Files:
-
- 24 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/ice.F90
r10882 r11536 102 102 !! vt_i | - | Total ice vol. per unit area | m | 103 103 !! vt_s | - | Total snow vol. per unit ar. | m | 104 !! st_i | - | Total Sea ice salt content | pss.m | 104 105 !! sm_i | - | Mean sea ice salinity | pss | 105 106 !! tm_i | - | Mean sea ice temperature | K | … … 109 110 !! bv_i | - | relative brine volume | ??? | 110 111 !! at_ip | - | Total ice pond concentration | | 112 !! hm_ip | - | Mean ice pond depth | m | 111 113 !! vt_ip | - | Total ice pond vol. per unit area| m | 112 114 !!===================================================================== … … 135 137 REAL(wp), PUBLIC :: rn_ishlat !: lateral boundary condition for sea-ice 136 138 LOGICAL , PUBLIC :: ln_landfast_L16 !: landfast ice parameterizationfrom lemieux2016 137 LOGICAL , PUBLIC :: ln_landfast_home !: landfast ice parameterizationfrom home made138 139 REAL(wp), PUBLIC :: rn_depfra !: fraction of ocean depth that ice must reach to initiate landfast ice 139 140 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home) … … 188 189 189 190 ! !!** ice-ponds namelist (namthd_pnd) 191 LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F) 190 192 LOGICAL , PUBLIC :: ln_pnd_H12 !: Melt ponds scheme from Holland et al 2012 191 193 LOGICAL , PUBLIC :: ln_pnd_CST !: Melt ponds scheme with constant fraction and depth … … 196 198 ! !!** ice-diagnostics namelist (namdia) ** 197 199 LOGICAL , PUBLIC :: ln_icediachk !: flag for ice diag (T) or not (F) 200 REAL(wp), PUBLIC :: rn_icechk_cel !: rate of ice spuriously gained/lost (at any gridcell) 201 REAL(wp), PUBLIC :: rn_icechk_glo !: rate of ice spuriously gained/lost (globally) 198 202 LOGICAL , PUBLIC :: ln_icediahsb !: flag for ice diag (T) or not (F) 199 203 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) … … 213 217 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 214 218 215 ! !!** some other parameters for advection using the ULTIMATE-MACHO scheme216 LOGICAL, PUBLIC, DIMENSION(2) :: l_split_advumx = .FALSE. ! force one iteration at the first time-step217 218 219 ! !!** define arrays 219 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics … … 251 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1] 252 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 253 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1]255 254 256 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [pss.kg.m-2.s-1 => g.m-2.s-1] … … 309 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 310 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 310 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m) 311 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 312 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area … … 334 334 335 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 336 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 337 338 … … 355 356 !! * Ice diagnostics 356 357 !!---------------------------------------------------------------------- 357 ! thd refers to changes induced by thermodynamics358 ! trp '' '' '' advection (transport of ice)359 !360 358 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 361 359 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume … … 369 367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 370 368 369 !!---------------------------------------------------------------------- 370 !! * Ice conservation 371 !!---------------------------------------------------------------------- 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_v !: conservation of ice volume 373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_s !: conservation of ice salt 374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_t !: conservation of ice heat 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fv !: conservation of ice volume 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fs !: conservation of ice salt 377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_ft !: conservation of ice heat 371 378 ! 372 379 !!---------------------------------------------------------------------- … … 393 400 INTEGER :: ice_alloc 394 401 ! 395 INTEGER :: ierr(1 5), ii402 INTEGER :: ierr(16), ii 396 403 !!----------------------------------------------------------------- 397 404 ierr(:) = 0 … … 409 416 & wfx_bog (jpi,jpj) , wfx_dyn (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 410 417 & wfx_res (jpi,jpj) , wfx_sni (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 411 & afx_tot (jpi,jpj) , rn_amax_2d(jpi,jpj),&418 & rn_amax_2d (jpi,jpj) , & 412 419 & qsb_ice_bot(jpi,jpj) , qlead (jpi,jpj) , & 413 420 & sfx_res (jpi,jpj) , sfx_bri (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & … … 429 436 ii = ii + 1 430 437 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 431 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , &432 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s 433 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s 438 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , & 439 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) , & 440 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) , & 434 441 & om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj) , STAT=ierr(ii) ) 435 442 … … 444 451 445 452 ii = ii + 1 446 ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) )453 ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 447 454 448 455 ! * Old values of global variables … … 465 472 & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 466 473 474 ! * Ice conservation 475 ii = ii + 1 476 ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj), & 477 & diag_fv(jpi,jpj) , diag_fs(jpi,jpj) , diag_ft(jpi,jpj), STAT=ierr(ii) ) 478 467 479 ! * SIMIP diagnostics 468 480 ii = ii + 1 -
NEMO/trunk/src/ICE/icealb.F90
r10535 r11536 192 192 REWIND( numnam_ice_ref ) ! Namelist namalb in reference namelist : Albedo parameters 193 193 READ ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 194 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist' , lwp)194 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist' ) 195 195 REWIND( numnam_ice_cfg ) ! Namelist namalb in configuration namelist : Albedo parameters 196 196 READ ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 197 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist' , lwp)197 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist' ) 198 198 IF(lwm) WRITE( numoni, namalb ) 199 199 ! -
NEMO/trunk/src/ICE/icecor.F90
r10994 r11536 17 17 USE phycst ! physical constants 18 18 USE ice ! sea-ice: variable 19 USE ice1D ! sea-ice: thermodynamic sea-icevariables19 USE ice1D ! sea-ice: thermodynamic variables 20 20 USE iceitd ! sea-ice: rebining 21 21 USE icevar ! sea-ice: operations … … 60 60 IF( ln_timing ) CALL timing_start('icecor') ! timing 61 61 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 62 IF( ln_icediachk ) CALL ice_cons2D (0, 'icecor', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 62 63 ! 63 64 IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN … … 78 79 ! !----------------------------------------------------- 79 80 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 80 DO jl 81 DO jl = 1, jpl 81 82 WHERE( at_i(:,:) > rn_amax_2d(:,:) ) a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 82 83 END DO … … 84 85 ! !----------------------------------------------------- 85 86 IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] ! 86 !!-----------------------------------------------------87 ! !----------------------------------------------------- 87 88 zzc = rhoi * r1_rdtice 88 89 DO jl = 1, jpl … … 117 118 END DO 118 119 END DO 119 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) ! lateral boundary conditions120 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 120 121 ENDIF 121 122 122 !!gm I guess the trends are only out on demand123 !! So please, only do this is it exite an iom_use of on a these variables124 !! furthermore, only allocate the diag_ arrays in this case125 !! and do the iom_put here so that it is only a local allocation126 !!gm127 123 ! !----------------------------------------------------- 128 124 SELECT CASE( kn ) ! Diagnostics ! … … 130 126 CASE( 1 ) !--- dyn trend diagnostics 131 127 ! 132 !!gm here I think the number of ice cat is too small to use a SUM instruction... 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 ! ! heat content variation (W.m-2) 136 diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & 137 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice 138 ! ! salt, volume 139 diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 140 diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 141 diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 142 END DO 143 END DO 128 IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 129 diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & ! W.m-2 130 & - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 131 diag_sice(:,:) = SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_rdtice * rhoi 132 diag_vice(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice * rhoi 133 diag_vsnw(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice * rhos 134 ENDIF 144 135 ! ! concentration tendency (dynamics) 145 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 146 afx_tot(:,:) = zafx(:,:) 147 IF( iom_use('afxdyn') ) CALL iom_put( 'afxdyn' , zafx(:,:) ) 136 IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 137 zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 138 CALL iom_put( 'afxdyn' , zafx ) 139 ENDIF 148 140 ! 149 141 CASE( 2 ) !--- thermo trend diagnostics & ice aging … … 151 143 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice ! ice natural aging incrementation 152 144 ! 153 !!gm here I think the number of ice cat is too small to use a SUM instruction... 154 DO jj = 1, jpj155 DO ji = 1, jpi156 ! ! heat content variation (W.m-2)157 diag_heat(ji,jj) = diag_heat(ji,jj) - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) &158 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice159 ! ! salt, volume160 diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice161 diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice162 diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice163 END DO164 END DO145 IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 146 diag_heat(:,:) = diag_heat(:,:) & 147 & - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & 148 & - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 149 diag_sice(:,:) = diag_sice(:,:) & 150 & + SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_rdtice * rhoi 151 diag_vice(:,:) = diag_vice(:,:) & 152 & + SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice * rhoi 153 diag_vsnw(:,:) = diag_vsnw(:,:) & 154 & + SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice * rhos 155 CALL iom_put ( 'hfxdhc' , diag_heat ) 156 ENDIF 165 157 ! ! concentration tendency (total + thermo) 166 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 167 afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 168 IF( iom_use('afxthd') ) CALL iom_put( 'afxthd' , zafx(:,:) ) 169 IF( iom_use('afxtot') ) CALL iom_put( 'afxtot' , afx_tot(:,:) ) 158 IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 159 zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 160 CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice ) 161 CALL iom_put( 'afxtot' , zafx ) 162 ENDIF 170 163 ! 171 164 END SELECT 172 165 ! 173 166 ! controls 174 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 175 IF( ln_ctl ) CALL ice_prt3D ('icecor') ! prints 176 IF( ln_icectl .AND. kn == 2 ) CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! prints 177 IF( ln_timing ) CALL timing_stop ('icecor') ! timing 167 IF( ln_ctl ) CALL ice_prt3D ('icecor') ! prints 168 IF( ln_icectl .AND. kn == 2 ) & 169 & CALL ice_prt ( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! prints 170 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 171 IF( ln_icediachk ) CALL ice_cons2D (1, 'icecor', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 172 IF( ln_timing ) CALL timing_stop ('icecor') ! timing 178 173 ! 179 174 END SUBROUTINE ice_cor -
NEMO/trunk/src/ICE/icectl.F90
r10994 r11536 12 12 !! 'key_si3' SI3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_cons_hsm : conservation tests on heat, salt and mass 15 !! ice_cons_final : conservation tests on heat, salt and mass at end of time step 14 !! ice_cons_hsm : conservation tests on heat, salt and mass during a time step (global) 15 !! ice_cons_final : conservation tests on heat, salt and mass at end of time step (global) 16 !! ice_cons2D : conservation tests on heat, salt and mass at each gridcell 16 17 !! ice_ctl : control prints in case of crash 17 18 !! ice_prt : control prints at a given grid point … … 27 28 ! 28 29 USE in_out_manager ! I/O manager 30 USE iom ! I/O manager library 29 31 USE lib_mpp ! MPP library 30 32 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 37 39 PUBLIC ice_cons_hsm 38 40 PUBLIC ice_cons_final 41 PUBLIC ice_cons2D 39 42 PUBLIC ice_ctl 40 43 PUBLIC ice_prt 41 44 PUBLIC ice_prt3D 42 45 46 ! thresold values for conservation 47 ! these values are changed by the namelist parameter rn_icechk, so that threshold = zchk * rn_icechk 48 REAL(wp), PARAMETER :: zchk_m = 1.e-5 ! kg/m2/s <=> 1mm of ice per year spuriously gained/lost 49 REAL(wp), PARAMETER :: zchk_s = 1.e-4 ! g/m2/s <=> 1mm of ice per year spuriously gained/lost (considering s=10g/kg) 50 REAL(wp), PARAMETER :: zchk_t = 3. ! W/m2 <=> 1mm of ice per year spuriously gained/lost (considering Lf=3e5J/kg) 51 43 52 !! * Substitutions 44 53 # include "vectopt_loop_substitute.h90" … … 59 68 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 60 69 !! It prints in ocean.output if there is a violation of conservation at each time-step 61 !! The thresholds (z v_sill, zs_sill, zt_sill) which determine violations are set to70 !! The thresholds (zchk_m, zchk_s, zchk_t) which determine violations are set to 62 71 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 63 72 !! For salt and heat thresholds, ice is considered to have a salinity of 10 … … 68 77 REAL(wp) , INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 69 78 !! 70 REAL(wp) :: z v, zs, zt, zfs, zfv, zft71 REAL(wp) :: zvmin, zamin, zamax, zeimin, zesmin, zsmin79 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat, & 80 & zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 72 81 REAL(wp) :: zvtrp, zetrp 73 REAL(wp) :: zarea, zv_sill, zs_sill, zt_sill 74 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 82 REAL(wp) :: zarea 75 83 !!------------------------------------------------------------------- 76 84 ! 77 85 IF( icount == 0 ) THEN 78 ! ! water flux 79 pdiag_fv = glob_sum( 'icectl', & 80 & -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + & 81 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:) + & 82 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + & 83 & wfx_ice_sub(:,:) + wfx_spr(:,:) & 84 & ) * e1e2t(:,:) ) * zconv 86 87 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 88 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) 89 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 90 91 ! mass flux 92 pdiag_fv = glob_sum( 'icectl', & 93 & ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 94 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 95 ! salt flux 96 pdiag_fs = glob_sum( 'icectl', & 97 & ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 98 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 99 ! heat flux 100 pdiag_ft = glob_sum( 'icectl', & 101 & ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 102 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 103 104 ELSEIF( icount == 1 ) THEN 105 106 ! -- mass diag -- ! 107 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice & 108 & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & 109 & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 110 & wfx_ice_sub + wfx_spr ) * e1e2t ) & 111 & - pdiag_fv 85 112 ! 86 ! ! salt flux87 pdiag_fs = glob_sum( 'icectl',&88 & ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +&89 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)&90 & ) * e1e2t(:,:) ) * zconv113 ! -- salt diag -- ! 114 zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice & 115 & + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 116 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 117 & - pdiag_fs 91 118 ! 92 ! ! heat flux 93 pdiag_ft = glob_sum( 'icectl', & 94 & ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 95 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 96 & ) * e1e2t(:,:) ) * zconv 97 98 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t * zconv ) 99 100 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t * zconv ) 101 102 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 103 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv 104 105 ELSEIF( icount == 1 ) THEN 106 107 ! water flux 108 zfv = glob_sum( 'icectl', & 109 & -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + & 110 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:) + & 111 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + & 112 & wfx_ice_sub(:,:) + wfx_spr(:,:) & 113 & ) * e1e2t(:,:) ) * zconv - pdiag_fv 114 115 ! salt flux 116 zfs = glob_sum( 'icectl', & 117 & ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 118 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 119 & ) * e1e2t(:,:) ) * zconv - pdiag_fs 120 121 ! heat flux 122 zft = glob_sum( 'icectl', & 123 & ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 124 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 125 & ) * e1e2t(:,:) ) * zconv - pdiag_ft 126 127 ! outputs 128 zv = ( ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) * zconv & 129 & - pdiag_v ) * r1_rdtice - zfv ) * rday 130 131 zs = ( ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) * zconv & 132 & - pdiag_s ) * r1_rdtice + zfs ) * rday 133 134 zt = ( glob_sum( 'icectl', & 135 & ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 136 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv & 137 & - pdiag_t ) * r1_rdtice + zft 138 139 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 140 zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) * zconv * rday 141 zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) * zconv 142 143 zamax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 144 zvmin = glob_min( 'icectl', v_i ) 145 zamin = glob_min( 'icectl', a_i ) 146 zsmin = glob_min( 'icectl', sv_i ) 147 zeimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 148 zesmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 149 150 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 151 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 152 zv_sill = zarea * 2.5e-5 153 zs_sill = zarea * 25.e-5 154 zt_sill = zarea * 10.e-5 155 156 IF(lwp) THEN 119 ! -- heat diag -- ! 120 zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 121 & ) * r1_rdtice & 122 & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 123 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & 124 & - pdiag_ft 125 126 ! -- min/max diag -- ! 127 zdiag_amax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 128 zdiag_vmin = glob_min( 'icectl', v_i ) 129 zdiag_amin = glob_min( 'icectl', a_i ) 130 zdiag_smin = glob_min( 'icectl', sv_i ) 131 zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 132 zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 133 134 ! -- advection scheme is conservative? -- ! 135 zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 136 zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) ! must be close to 0 137 138 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 139 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 140 141 IF( lwp ) THEN 157 142 ! check conservation issues 158 IF ( ABS( zv ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day] (',cd_routine,') = ',zv 159 IF ( ABS( zs ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zs 160 IF ( ABS( zt ) > zt_sill ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',zt 143 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 144 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 145 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 146 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 147 IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 148 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 149 ! check negative values 150 IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin 151 IF( zdiag_amin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_amin 152 IF( zdiag_smin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_smin 153 IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin 154 IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin 161 155 ! check maximum ice concentration 162 IF ( zamax > MAX( rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 163 & WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 164 ! check negative values 165 IF ( zvmin < 0. ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',zvmin 166 IF ( zamin < 0. ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 167 IF ( zsmin < 0. ) WRITE(numout,*) 'violation s_i<0 (',cd_routine,') = ',zsmin 168 IF ( zeimin < 0. ) WRITE(numout,*) 'violation e_i<0 (',cd_routine,') = ',zeimin 169 IF ( zesmin < 0. ) WRITE(numout,*) 'violation e_s<0 (',cd_routine,') = ',zesmin 170 !clem: the following check fails (I think...) 171 ! IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'icedyn_adv' ) THEN 172 ! WRITE(numout,*) 'violation vtrp [Mt/day] (',cd_routine,') = ',zvtrp 173 ! WRITE(numout,*) 'violation etrp [GW] (',cd_routine,') = ',zetrp 174 ! ENDIF 156 IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 157 & WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_amax 158 ! check if advection scheme is conservative 159 IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 160 & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 175 161 ENDIF 176 162 ! … … 179 165 END SUBROUTINE ice_cons_hsm 180 166 181 182 167 SUBROUTINE ice_cons_final( cd_routine ) 183 168 !!------------------------------------------------------------------- … … 188 173 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 189 174 !! It prints in ocean.output if there is a violation of conservation at each time-step 190 !! The thresholds (z v_sill, zs_sill, zt_sill) which determine the violation are set to175 !! The thresholds (zchk_m, zchk_s, zchk_t) which determine the violation are set to 191 176 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 192 177 !! For salt and heat thresholds, ice is considered to have a salinity of 10 193 178 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 194 179 !!------------------------------------------------------------------- 195 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 196 REAL(wp) :: zqmass, zhfx, zsfx, zvfx 197 REAL(wp) :: zarea, zv_sill, zs_sill, zt_sill 198 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 180 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 181 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat 182 REAL(wp) :: zarea 199 183 !!------------------------------------------------------------------- 200 184 201 185 ! water flux 202 zvfx = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday 203 204 ! salt flux 205 zsfx = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) * zconv * rday 206 207 ! heat flux 186 ! -- mass diag -- ! 187 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 188 189 ! -- salt diag -- ! 190 zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 191 192 ! -- heat diag -- ! 208 193 ! clem: not the good formulation 209 !!zhfx = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr & 210 !! & ) * e1e2t ) * zconv 211 212 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 213 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 214 zv_sill = zarea * 2.5e-5 215 zs_sill = zarea * 25.e-5 216 zt_sill = zarea * 10.e-5 217 218 IF(lwp) THEN 219 IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',zvfx 220 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',zsfx 221 !!IF( ABS( zhfx ) > zt_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',zhfx 194 !!zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr & 195 !! & ) * e1e2t ) 196 197 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 198 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 199 200 IF( lwp ) THEN 201 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 202 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 203 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 204 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 205 !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 222 206 ENDIF 223 207 ! 224 208 END SUBROUTINE ice_cons_final 225 209 210 SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft ) 211 !!------------------------------------------------------------------- 212 !! *** ROUTINE ice_cons2D *** 213 !! 214 !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 215 !! + test if ice concentration and volume are > 0 216 !! 217 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 218 !! It stops the code if there is a violation of conservation at any gridcell 219 !!------------------------------------------------------------------- 220 INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end 221 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 222 REAL(wp) , DIMENSION(jpi,jpj), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 223 !! 224 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, & 225 & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 226 INTEGER :: jl, jk 227 LOGICAL :: ll_stop_m = .FALSE. 228 LOGICAL :: ll_stop_s = .FALSE. 229 LOGICAL :: ll_stop_t = .FALSE. 230 CHARACTER(len=120) :: clnam ! filename for the output 231 !!------------------------------------------------------------------- 232 ! 233 IF( icount == 0 ) THEN 234 235 pdiag_v = SUM( v_i * rhoi + v_s * rhos, dim=3 ) 236 pdiag_s = SUM( sv_i * rhoi , dim=3 ) 237 pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 238 239 ! mass flux 240 pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 241 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 242 ! salt flux 243 pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 244 ! heat flux 245 pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 246 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 247 248 ELSEIF( icount == 1 ) THEN 249 250 ! -- mass diag -- ! 251 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice & 252 & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 253 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) & 254 & - pdiag_fv 255 IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel ) ll_stop_m = .TRUE. 256 ! 257 ! -- salt diag -- ! 258 zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice & 259 & + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 260 & - pdiag_fs 261 IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel ) ll_stop_s = .TRUE. 262 ! 263 ! -- heat diag -- ! 264 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice & 265 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 266 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) & 267 & - pdiag_ft 268 IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel ) ll_stop_t = .TRUE. 269 ! 270 ! -- other diags -- ! 271 ! a_i < 0 272 zdiag_amin(:,:) = 0._wp 273 DO jl = 1, jpl 274 WHERE( a_i(:,:,jl) < 0._wp ) zdiag_amin(:,:) = 1._wp 275 ENDDO 276 ! v_i < 0 277 zdiag_vmin(:,:) = 0._wp 278 DO jl = 1, jpl 279 WHERE( v_i(:,:,jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp 280 ENDDO 281 ! s_i < 0 282 zdiag_smin(:,:) = 0._wp 283 DO jl = 1, jpl 284 WHERE( s_i(:,:,jl) < 0._wp ) zdiag_smin(:,:) = 1._wp 285 ENDDO 286 ! e_i < 0 287 zdiag_emin(:,:) = 0._wp 288 DO jl = 1, jpl 289 DO jk = 1, nlay_i 290 WHERE( e_i(:,:,jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp 291 ENDDO 292 ENDDO 293 ! a_i > amax 294 !WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 ) ; zdiag_amax(:,:) = 1._wp 295 !ELSEWHERE ; zdiag_amax(:,:) = 0._wp 296 !END WHERE 297 298 IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN 299 clnam = 'diag_ice_conservation_'//cd_routine 300 CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin ) 301 ENDIF 302 303 IF( ll_stop_m ) CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' ) 304 IF( ll_stop_s ) CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 305 IF( ll_stop_t ) CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 306 307 ENDIF 308 309 END SUBROUTINE ice_cons2D 310 311 SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin ) 312 !!--------------------------------------------------------------------- 313 !! *** ROUTINE ice_cons_wri *** 314 !! 315 !! ** Purpose : create a NetCDF file named cdfile_name which contains 316 !! the instantaneous fields when conservation issue occurs 317 !! 318 !! ** Method : NetCDF files using ioipsl 319 !!---------------------------------------------------------------------- 320 CHARACTER(len=*), INTENT( in ) :: cdfile_name ! name of the file created 321 REAL(wp), DIMENSION(:,:), INTENT( in ) :: pdiag_mass, pdiag_salt, pdiag_heat, & 322 & pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 323 !! 324 INTEGER :: inum 325 !!---------------------------------------------------------------------- 326 ! 327 IF(lwp) WRITE(numout,*) 328 IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 329 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ named :', cdfile_name, '...nc' 330 IF(lwp) WRITE(numout,*) 331 332 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 333 334 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain 335 CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 ) ! ice salt spurious lost/gain 336 CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 ) ! ice heat spurious lost/gain 337 ! other diags 338 CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) ! 339 CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) ! 340 CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) ! 341 CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) ! 342 343 CALL iom_close( inum ) 344 345 END SUBROUTINE ice_cons_wri 226 346 227 347 SUBROUTINE ice_ctl( kt ) … … 246 366 ialert_id = 2 ! reference number of this alert 247 367 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 248 249 368 DO jl = 1, jpl 250 369 DO jj = 1, jpj 251 370 DO ji = 1, jpi 252 371 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 253 !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 254 !WRITE(numout,*) ' at_i ', at_i(ji,jj) 255 !WRITE(numout,*) ' Point - category', ji, jj, jl 256 !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl) 257 !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl) 372 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 258 373 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 259 374 ENDIF … … 269 384 DO ji = 1, jpi 270 385 IF( h_i(ji,jj,jl) > 50._wp ) THEN 386 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 271 387 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 272 388 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 280 396 DO jj = 1, jpj 281 397 DO ji = 1, jpi 282 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5.AND. &398 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 283 399 & at_i(ji,jj) > 0._wp ) THEN 400 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 284 401 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 285 !WRITE(numout,*) ' ice strength : ', strength(ji,jj) 286 !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 287 !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 288 !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj) 289 !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj) 290 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 291 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 292 !WRITE(numout,*) 402 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 403 ENDIF 404 END DO 405 END DO 406 407 ! Alert on salt flux 408 ialert_id = 5 ! reference number of this alert 409 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 413 WRITE(numout,*) ' ALERTE 5 : High salt flux' 414 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 293 415 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 294 416 ENDIF … … 302 424 DO ji = 1, jpi 303 425 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 426 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 304 427 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 305 !WRITE(numout,*) ' masks s, u, v : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)306 !WRITE(numout,*) ' sst : ', sst_m(ji,jj)307 !WRITE(numout,*) ' sss : ', sss_m(ji,jj)308 !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj)309 !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj)310 !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1)311 !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj)312 !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj)313 !314 428 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 315 429 ENDIF … … 325 439 DO ji = 1, jpi 326 440 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 441 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 327 442 ! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 328 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj)329 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj)330 ! WRITE(numout,*)331 443 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 332 444 ENDIF … … 335 447 END DO 336 448 ! 449 ! Alert if qns very big 450 ialert_id = 8 ! reference number of this alert 451 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 455 ! 456 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 457 !CALL ice_prt( kt, ji, jj, 2, ' ') 458 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 459 ! 460 ENDIF 461 END DO 462 END DO 463 !+++++ 337 464 338 465 ! ! Alert if too old ice … … 345 472 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 346 473 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 474 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 347 475 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 348 476 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 351 479 END DO 352 480 END DO 353 354 ! Alert on salt flux 355 ialert_id = 5 ! reference number of this alert 356 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 360 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 361 !DO jl = 1, jpl 362 !WRITE(numout,*) ' Category no: ', jl 363 !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl) 364 !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl) 365 !WRITE(numout,*) ' ' 366 !END DO 367 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 368 ENDIF 369 END DO 370 END DO 371 372 ! Alert if qns very big 373 ialert_id = 8 ! reference number of this alert 374 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 378 ! 379 !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 380 !WRITE(numout,*) ' ji, jj : ', ji, jj 381 !WRITE(numout,*) ' qns : ', qns(ji,jj) 382 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 383 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 384 ! 385 !CALL ice_prt( kt, ji, jj, 2, ' ') 386 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 387 ! 388 ENDIF 389 END DO 390 END DO 391 !+++++ 392 481 393 482 ! Alert if very warm ice 394 483 ialert_id = 10 ! reference number of this alert … … 400 489 DO ji = 1, jpi 401 490 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 402 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 403 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 404 !WRITE(numout,*) ' ALERTE 10 : Very warm ice' 405 !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 406 !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 407 !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 408 !WRITE(numout,*) ' sz_i: ', sz_i(ji,jj,jk,jl) 409 !WRITE(numout,*) ' ztmelts : ', ztmelts 410 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 491 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 492 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 493 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 494 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 411 495 ENDIF 412 496 END DO … … 435 519 END SUBROUTINE ice_ctl 436 520 437 438 521 SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 439 522 !!------------------------------------------------------------------- … … 443 526 !! in ocean.ouput 444 527 !! 3 possibilities exist 445 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1)528 !! n = 1/-1 -> simple ice state 446 529 !! n = 2 -> exhaustive state 447 530 !! n = 3 -> ice/ocean salt fluxes … … 482 565 WRITE(numout,*) ' - Cell values ' 483 566 WRITE(numout,*) ' ~~~~~~~~~~~ ' 484 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)485 567 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 568 WRITE(numout,*) ' ato_i : ', ato_i(ji,jj) 486 569 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 487 570 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) … … 503 586 END DO 504 587 ENDIF 505 IF( kn == -1 ) THEN506 WRITE(numout,*) ' Mechanical Check ************** '507 WRITE(numout,*) ' Check what means ice divergence '508 WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)509 WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj)510 WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj)511 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00512 ENDIF513 514 588 515 589 !-------------------- … … 525 599 WRITE(numout,*) ' - Cell values ' 526 600 WRITE(numout,*) ' ~~~~~~~~~~~ ' 527 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)528 601 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 529 602 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) … … 624 697 !! 625 698 !!------------------------------------------------------------------- 626 CHARACTER(len=*), INTENT(in) ::cd_routine ! name of the routine627 INTEGER ::jk, jl ! dummy loop indices699 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 700 INTEGER :: jk, jl ! dummy loop indices 628 701 629 702 CALL prt_ctl_info(' ========== ') … … 684 757 685 758 END SUBROUTINE ice_prt3D 686 759 687 760 #else 688 761 !!---------------------------------------------------------------------- -
NEMO/trunk/src/ICE/icedia.F90
r10425 r11536 34 34 PUBLIC ice_dia_init ! called in icestp.F90 35 35 36 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 36 REAL(wp), SAVE :: z1_e1e2 ! inverse of the ocean area 37 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 37 38 REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends 38 39 … … 80 81 ENDIF 81 82 82 !!gm glob_sum includes a " * tmask_i ", so remove " * tmask(:,:,1) " 83 83 IF( kt == nit000 ) THEN 84 z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) ) 85 ENDIF 86 84 87 ! ----------------------- ! 85 ! 1 - Contents !88 ! 1 - Contents ! 86 89 ! ----------------------- ! 87 zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! ice volume (km3) 88 zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9 ! snow volume (km3) 89 zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6 ! area (km2) 90 zbg_isal = glob_sum( 'icedia', SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9 ! salt content (pss*km3) 91 zbg_item = glob_sum( 'icedia', et_i * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 92 zbg_stem = glob_sum( 'icedia', et_s * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 93 90 IF( iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. & 91 & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN 92 93 zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! ice volume (km3) 94 zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9 ! snow volume (km3) 95 zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6 ! area (km2) 96 zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! salt content (pss*km3) 97 zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 98 zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 99 100 CALL iom_put( 'ibgvol_tot' , zbg_ivol ) 101 CALL iom_put( 'sbgvol_tot' , zbg_svol ) 102 CALL iom_put( 'ibgarea_tot' , zbg_area ) 103 CALL iom_put( 'ibgsalt_tot' , zbg_isal ) 104 CALL iom_put( 'ibgheat_tot' , zbg_item ) 105 CALL iom_put( 'sbgheat_tot' , zbg_stem ) 106 107 ENDIF 108 94 109 ! ---------------------------! 95 110 ! 2 - Trends due to forcing ! 96 111 ! ---------------------------! 112 ! they must be kept outside an IF(iom_use) because of the call to dia_rst below 97 113 z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-ocean 98 114 z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-atm … … 106 122 frc_temtop = frc_temtop + z_frc_temtop * rdt_ice ! 1.e20 J 107 123 frc_tembot = frc_tembot + z_frc_tembot * rdt_ice ! 1.e20 J 124 125 CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 126 CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 127 CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 128 CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 129 CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 130 131 IF( iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN 132 CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean (W/m2) 133 CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice) (W/m2) 134 ENDIF 135 136 ! ---------------------------------- ! 137 ! 3 - Content variations and drifts ! 138 ! ---------------------------------- ! 139 IF( iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN 108 140 109 ! ----------------------- ! 110 ! 3 - Content variations ! 111 ! ----------------------- ! 112 zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 113 zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 114 zdiff_tem = glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 115 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 116 117 ! ----------------------- ! 118 ! 4 - Drifts ! 119 ! ----------------------- ! 120 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 121 zdiff_sal = zdiff_sal - frc_sal 122 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 123 124 ! ----------------------- ! 125 ! 5 - Diagnostics writing ! 126 ! ----------------------- ! 127 !!gm I don't understand the division by the ocean surface (i.e. glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 128 !! and its multiplication bu kt ! is it really what we want ? what is this quantity ? 129 !! IF it is really what we want, compute it at kt=nit000, not 3 time by time-step ! 130 !! kt*rdt : you mean rdtice ? 131 !!gm 132 ! 133 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 134 IF( iom_use('ibgsaltco') ) CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 135 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 136 IF( iom_use('ibgheatfx') ) CALL iom_put( 'ibgheatfx' , & ! ice/snow heat flux drift (W/m2) 137 & zdiff_tem /glob_sum( 'icedia', e1e2t(:,:) * 1.e-20 * kt*rdt ) ) 138 139 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 140 IF( iom_use('ibgfrcvolbot') ) CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 141 IF( iom_use('ibgfrcsal') ) CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 142 IF( iom_use('ibgfrctemtop') ) CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 143 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 144 IF( iom_use('ibgfrchfxtop') ) CALL iom_put( 'ibgfrchfxtop' , & ! heat on top of ice/snw/ocean (W/m2) 145 & frc_temtop / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 146 IF( iom_use('ibgfrchfxbot') ) CALL iom_put( 'ibgfrchfxbot' , & ! heat on top of ocean(below ice) (W/m2) 147 & frc_tembot / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 148 149 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) 150 IF( iom_use('sbgvol_tot' ) ) CALL iom_put( 'sbgvol_tot' , zbg_svol ) ! snow volume (km3) 151 IF( iom_use('ibgarea_tot') ) CALL iom_put( 'ibgarea_tot' , zbg_area ) ! ice area (km2) 152 IF( iom_use('ibgsalt_tot') ) CALL iom_put( 'ibgsalt_tot' , zbg_isal ) ! ice salinity content (pss*km3) 153 IF( iom_use('ibgheat_tot') ) CALL iom_put( 'ibgheat_tot' , zbg_item ) ! ice heat content (1.e20 J) 154 IF( iom_use('sbgheat_tot') ) CALL iom_put( 'sbgheat_tot' , zbg_stem ) ! snow heat content (1.e20 J) 155 ! 141 zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 142 zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 143 zdiff_tem = glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 144 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 145 146 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 147 zdiff_sal = zdiff_sal - frc_sal 148 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 149 150 CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 151 CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 152 CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 153 ! 154 ENDIF 155 156 156 IF( lrst_ice ) CALL ice_dia_rst( 'WRITE', kt_ice ) 157 157 ! … … 175 175 INTEGER :: ios, ierror ! local integer 176 176 !! 177 NAMELIST/namdia/ ln_icediachk, ln_icediahsb, ln_icectl, iiceprt, jiceprt177 NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt 178 178 !!---------------------------------------------------------------------- 179 179 ! 180 180 REWIND( numnam_ice_ref ) ! Namelist namdia in reference namelist : Parameters for ice 181 181 READ ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist' , lwp)182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist' ) 183 183 REWIND( numnam_ice_cfg ) ! Namelist namdia in configuration namelist : Parameters for ice 184 184 READ ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 185 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist' , lwp)185 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist' ) 186 186 IF(lwm) WRITE ( numoni, namdia ) 187 187 ! … … 191 191 WRITE(numout,*) ' ~~~~~~~~~~~' 192 192 WRITE(numout,*) ' Namelist namdia:' 193 WRITE(numout,*) ' Diagnose online heat/mass/salt budget ln_icediachk = ', ln_icediachk 194 WRITE(numout,*) ' Output heat/mass/salt budget ln_icediahsb = ', ln_icediahsb 195 WRITE(numout,*) ' control prints for a given grid point ln_icectl = ', ln_icectl 196 WRITE(numout,*) ' chosen grid point position (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')' 193 WRITE(numout,*) ' Diagnose online heat/mass/salt conservation ln_icediachk = ', ln_icediachk 194 WRITE(numout,*) ' threshold for conservation (gridcell) rn_icechk_cel = ', rn_icechk_cel 195 WRITE(numout,*) ' threshold for conservation (global) rn_icechk_glo = ', rn_icechk_glo 196 WRITE(numout,*) ' Output heat/mass/salt budget ln_icediahsb = ', ln_icediahsb 197 WRITE(numout,*) ' control prints for a given grid point ln_icectl = ', ln_icectl 198 WRITE(numout,*) ' chosen grid point position (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')' 197 199 ENDIF 198 200 ! … … 248 250 vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:) ! ice/snow volume (kg/m2) 249 251 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J) 250 sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )! ice salt content (pss*kg/m2)252 sal_loc_ini(:,:) = rhoi * st_i(:,:) ! ice salt content (pss*kg/m2) 251 253 ENDIF 252 254 ! -
NEMO/trunk/src/ICE/icedyn.F90
r10994 r11536 163 163 END DO 164 164 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 165 CALL iom_put( "icediv" , zdivu_i(:,:) ) 165 ! output 166 CALL iom_put( 'icediv' , zdivu_i ) 167 166 168 DEALLOCATE( zdivu_i ) 167 169 … … 219 221 NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice, & 220 222 & rn_ishlat , & 221 & ln_landfast_L16, ln_landfast_home,rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile223 & ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 222 224 !!------------------------------------------------------------------- 223 225 ! 224 226 REWIND( numnam_ice_ref ) ! Namelist namdyn in reference namelist : Ice dynamics 225 227 READ ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 226 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist' , lwp)228 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist' ) 227 229 REWIND( numnam_ice_cfg ) ! Namelist namdyn in configuration namelist : Ice dynamics 228 230 READ ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 229 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist' , lwp)231 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist' ) 230 232 IF(lwm) WRITE( numoni, namdyn ) 231 233 ! … … 242 244 WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat 243 245 WRITE(numout,*) ' Landfast: param from Lemieux 2016 ln_landfast_L16 = ', ln_landfast_L16 244 WRITE(numout,*) ' Landfast: param from home made ln_landfast_home= ', ln_landfast_home245 246 WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_depfra = ', rn_depfra 246 247 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr … … 269 270 ENDIF 270 271 ! !--- Landfast ice 271 IF( .NOT.ln_landfast_L16 .AND. .NOT.ln_landfast_home ) tau_icebfr(:,:) = 0._wp 272 ! 273 IF ( ln_landfast_L16 .AND. ln_landfast_home ) THEN 274 CALL ctl_stop( 'ice_dyn_init: choose one and only one landfast parameterization (ln_landfast_L16 or ln_landfast_home)' ) 275 ENDIF 272 IF( .NOT.ln_landfast_L16 ) tau_icebfr(:,:) = 0._wp 276 273 ! 277 274 CALL ice_dyn_rdgrft_init ! set ice ridging/rafting parameters -
NEMO/trunk/src/ICE/icedyn_adv.F90
r10911 r11536 100 100 diag_trp_vi(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice 101 101 diag_trp_vs(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice 102 IF( iom_use('icemtrp') ) CALL iom_put( "icemtrp" ,diag_trp_vi * rhoi ) ! ice mass transport103 IF( iom_use('snwmtrp') ) CALL iom_put( "snwmtrp" ,diag_trp_vs * rhos ) ! snw mass transport104 IF( iom_use('salmtrp') ) CALL iom_put( "salmtrp" ,diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s)105 IF( iom_use('dihctrp') ) CALL iom_put( "dihctrp" , -diag_trp_ei) ! advected ice heat content (W/m2)106 IF( iom_use('dshctrp') ) CALL iom_put( "dshctrp" , -diag_trp_es) ! advected snw heat content (W/m2)102 IF( iom_use('icemtrp') ) CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi ) ! ice mass transport 103 IF( iom_use('snwmtrp') ) CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos ) ! snw mass transport 104 IF( iom_use('salmtrp') ) CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s) 105 IF( iom_use('dihctrp') ) CALL iom_put( 'dihctrp' , -diag_trp_ei ) ! advected ice heat content (W/m2) 106 IF( iom_use('dshctrp') ) CALL iom_put( 'dshctrp' , -diag_trp_es ) ! advected snw heat content (W/m2) 107 107 108 108 ! controls … … 133 133 REWIND( numnam_ice_ref ) ! Namelist namdyn_adv in reference namelist : Ice dynamics 134 134 READ ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 135 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' , lwp)135 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 136 136 REWIND( numnam_ice_cfg ) ! Namelist namdyn_adv in configuration namelist : Ice dynamics 137 137 READ ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 138 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' , lwp)138 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 139 139 IF(lwm) WRITE( numoni, namdyn_adv ) 140 140 ! -
NEMO/trunk/src/ICE/icedyn_rdgrft.F90
r10994 r11536 145 145 IF( ln_timing ) CALL timing_start('icedyn_rdgrft') ! timing 146 146 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 147 IF( ln_icediachk ) CALL ice_cons2D (0, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 147 148 148 149 IF( kt == nit000 ) THEN … … 276 277 277 278 ! controls 279 IF( ln_ctl ) CALL ice_prt3D ('icedyn_rdgrft') ! prints 278 280 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 279 IF( ln_ ctl ) CALL ice_prt3D ('icedyn_rdgrft') ! prints281 IF( ln_icediachk ) CALL ice_cons2D (1, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 280 282 IF( ln_timing ) CALL timing_stop ('icedyn_rdgrft') ! timing 281 283 ! … … 916 918 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 917 919 READ ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 918 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' , lwp)920 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 919 921 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 920 922 READ ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 921 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' , lwp)923 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 922 924 IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 923 925 ! -
NEMO/trunk/src/ICE/icedyn_rhg.F90
r10911 r11536 64 64 IF( ln_timing ) CALL timing_start('icedyn_rhg') ! timing 65 65 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 66 IF( ln_icediachk ) CALL ice_cons2D (0, 'icedyn_rhg', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 66 67 ! 67 68 IF( kt == nit000 .AND. lwp ) THEN … … 69 70 WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology' 70 71 WRITE(numout,*)'~~~~~~~~~~~' 71 ENDIF72 !73 IF( ln_landfast_home ) THEN !-- Landfast ice parameterization74 tau_icebfr(:,:) = 0._wp75 DO jl = 1, jpl76 WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_depfra ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr77 END DO78 72 ENDIF 79 73 ! … … 94 88 ! 95 89 ! controls 90 IF( ln_ctl ) CALL ice_prt3D ('icedyn_rhg') ! prints 96 91 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 97 IF( ln_ ctl ) CALL ice_prt3D ('icedyn_rhg') ! prints92 IF( ln_icediachk ) CALL ice_cons2D (1, 'icedyn_rhg', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 98 93 IF( ln_timing ) CALL timing_stop ('icedyn_rhg') ! timing 99 94 ! … … 120 115 REWIND( numnam_ice_ref ) ! Namelist namdyn_rhg in reference namelist : Ice dynamics 121 116 READ ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 122 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' , lwp)117 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' ) 123 118 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 124 119 READ ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) 125 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' , lwp)120 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' ) 126 121 IF(lwm) WRITE ( numoni, namdyn_rhg ) 127 122 ! -
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r10891 r11536 112 112 REAL(wp), DIMENSION(:,:), INTENT( out) :: pshear_i , pdivu_i , pdelta_i ! 113 113 !! 114 LOGICAL, PARAMETER :: ll_bdy_substep = .TRUE. ! temporary option to call bdy at each sub-time step (T)115 ! or only at the main time step (F)116 114 INTEGER :: ji, jj ! dummy loop indices 117 115 INTEGER :: jter ! local integers … … 123 121 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 124 122 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 125 REAL(wp) :: zTauO, zTauB, z TauE, zvel! temporary scalars123 REAL(wp) :: zTauO, zTauB, zRHS, zvel ! temporary scalars 126 124 REAL(wp) :: zkt ! isotropic tensile strength for landfast ice 127 125 REAL(wp) :: zvCr ! critical ice volume above which ice is landfast … … 132 130 REAL(wp) :: zshear, zdum1, zdum2 133 131 ! 134 REAL(wp), DIMENSION(jpi,jpj) :: z1_e1t0, z1_e2t0 ! scale factors135 132 REAL(wp), DIMENSION(jpi,jpj) :: zp_delt ! P/delta at T points 136 133 REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017 137 134 ! 138 135 REAL(wp), DIMENSION(jpi,jpj) :: zdt_m ! (dt / ice-snow_mass) on T points 139 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV! ice fraction on U/V points136 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points 140 137 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points 141 138 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 142 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points143 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ib , ztauV_ib ! ice-bottom stress at U-V points (landfast param)144 REAL(wp), DIMENSION(jpi,jpj) :: zspgU , zspgV ! surface pressure gradient at U/V points145 139 REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 146 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses147 140 ! 148 141 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear … … 152 145 ! ! ocean surface (ssh_m) if ice is not embedded 153 146 ! ! ice bottom surface if ice is embedded 154 REAL(wp), DIMENSION(jpi,jpj) :: zCorx, zCory ! Coriolis stress array 155 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! Ocean-to-ice stress array 156 ! 157 REAL(wp), DIMENSION(jpi,jpj) :: zswitchU, zswitchV ! dummy arrays 158 REAL(wp), DIMENSION(jpi,jpj) :: zmaskU, zmaskV ! mask for ice presence 147 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses 148 REAL(wp), DIMENSION(jpi,jpj) :: zspgU, zspgV ! surface pressure gradient at U/V points 149 REAL(wp), DIMENSION(jpi,jpj) :: zCorU, zCorV ! Coriolis stress array 150 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_ai, ztauy_ai ! ice-atm. stress at U-V points 151 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! ice-ocean stress at U-V points 152 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_bi, ztauy_bi ! ice-OceanBottom stress at U-V points (landfast) 153 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 154 ! 155 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 156 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 159 157 REAL(wp), DIMENSION(jpi,jpj) :: zfmask, zwf ! mask at F points for the ice 160 158 … … 163 161 REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small 164 162 !! --- diags 165 REAL(wp), DIMENSION(jpi,jpj) :: z swi163 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00 166 164 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig1, zsig2, zsig3 167 165 !! --- SIMIP diags 168 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_sig1 ! Average normal stress in sea ice169 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_sig2 ! Maximum shear stress in sea ice170 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_dssh_dx ! X-direction sea-surface tilt term (N/m2)171 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_dssh_dy ! X-direction sea-surface tilt term (N/m2)172 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_corstrx ! X-direction coriolis stress (N/m2)173 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_corstry ! Y-direction coriolis stress (N/m2)174 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_intstrx ! X-direction internal stress (N/m2)175 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_intstry ! Y-direction internal stress (N/m2)176 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_utau_oi ! X-direction ocean-ice stress177 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_vtau_oi ! Y-direction ocean-ice stress178 166 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) 179 167 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s) … … 255 243 CALL ice_strength 256 244 257 ! scale factors258 DO jj = 2, jpjm1259 DO ji = fs_2, fs_jpim1260 z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj ) + e1t(ji,jj ) )261 z1_e2t0(ji,jj) = 1._wp / ( e2t(ji ,jj+1) + e2t(ji,jj ) )262 END DO263 END DO264 265 245 ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 266 IF( ln_landfast_L16 .OR. ln_landfast_home) THEN ; zkt = rn_tensile267 ELSE 246 IF( ln_landfast_L16 ) THEN ; zkt = rn_tensile 247 ELSE ; zkt = 0._wp 268 248 ENDIF 269 249 ! … … 291 271 292 272 ! Ocean currents at U-V points 293 v_oceU(ji,jj) = 0.5_wp * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji+1,jj) & 294 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 295 296 u_oceV(ji,jj) = 0.5_wp * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj+1) & 297 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 273 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 274 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 298 275 299 276 ! Coriolis at T points (m*f) … … 308 285 309 286 ! Drag ice-atm. 310 z TauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)311 z TauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)287 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 288 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 312 289 313 290 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points … … 316 293 317 294 ! masks 318 zm askU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice319 zm askV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice295 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 296 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 320 297 321 298 ! switches 322 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; z switchU(ji,jj) = 0._wp323 ELSE ; z switchU(ji,jj) = 1._wp ; ENDIF324 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; z switchV(ji,jj) = 0._wp325 ELSE ; z switchV(ji,jj) = 1._wp ; ENDIF299 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 300 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 301 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 302 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 326 303 327 304 END DO … … 339 316 ! ice-bottom stress at U points 340 317 zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj) 341 z TauU_ib(ji,jj) =rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )318 ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 342 319 ! ice-bottom stress at V points 343 320 zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj) 344 z TauV_ib(ji,jj) =rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )321 ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 345 322 ! ice_bottom stress at T points 346 323 zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj) 347 tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )324 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 348 325 END DO 349 326 END DO 350 327 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 351 328 ! 352 ELSE IF( ln_landfast_home ) THEN !-- Home made329 ELSE !-- no landfast 353 330 DO jj = 2, jpjm1 354 331 DO ji = fs_2, fs_jpim1 355 zTauU_ib(ji,jj) = tau_icebfr(ji,jj) 356 zTauV_ib(ji,jj) = tau_icebfr(ji,jj) 357 END DO 358 END DO 359 ! 360 ELSE !-- no landfast 361 DO jj = 2, jpjm1 362 DO ji = fs_2, fs_jpim1 363 zTauU_ib(ji,jj) = 0._wp 364 zTauV_ib(ji,jj) = 0._wp 332 ztaux_base(ji,jj) = 0._wp 333 ztauy_base(ji,jj) = 0._wp 365 334 END DO 366 335 END DO 367 336 ENDIF 368 IF( iom_use('tau_icebfr') ) CALL iom_put( 'tau_icebfr', tau_icebfr(:,:) )369 337 370 338 !------------------------------------------------------------------------------! … … 372 340 !------------------------------------------------------------------------------! 373 341 ! 374 ! ! ----------------------!342 ! ! ==================== ! 375 343 DO jter = 1 , nn_nevp ! loop over jter ! 376 ! ! ----------------------!344 ! ! ==================== ! 377 345 l_full_nf_update = jter == nn_nevp ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 378 346 ! … … 479 447 & ) * r1_e1e2v(ji,jj) 480 448 ! 481 ! !--- u_ice atV point482 u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) &483 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)449 ! !--- ice currents at U-V point 450 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 451 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 484 452 ! 485 ! !--- v_ice at U point486 v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) &487 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)488 453 END DO 489 454 END DO … … 504 469 ! !--- tau_bottom/v_ice 505 470 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 506 zTauB = - zTauV_ib(ji,jj) / zvel 471 zTauB = ztauy_base(ji,jj) / zvel 472 ! !--- OceanBottom-to-Ice stress 473 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 507 474 ! 508 475 ! !--- Coriolis at V-points (energy conserving formulation) 509 zCor y(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &476 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 510 477 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 511 478 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 512 479 ! 513 480 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 514 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 515 ! 516 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 517 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 481 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 482 ! 483 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 484 ! 1 = sliding friction : TauB < RHS 485 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 518 486 ! 519 487 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 520 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )& ! previous velocity521 & + zTauE + zTauO * v_ice(ji,jj)& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)522 & )/ MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast523 &+ ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0524 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin525 & ) * zmaskV(ji,jj)488 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 489 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 490 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 491 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 492 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 493 & ) * zmsk00y(ji,jj) 526 494 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 527 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) &! previous velocity528 & + zTauE + zTauO * v_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)529 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast530 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0531 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) ) &! v_ice = v_oce/100 if mass < zmmin & conc < zamin532 & ) * zmaskV(ji,jj)495 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 496 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 497 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 498 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 499 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 500 & ) * zmsk00y(ji,jj) 533 501 ENDIF 534 502 END DO … … 540 508 CALL agrif_interp_ice( 'V' ) 541 509 #endif 542 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'V' )510 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 543 511 ! 544 512 DO jj = 2, jpjm1 … … 552 520 ! !--- tau_bottom/u_ice 553 521 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 554 zTauB = - zTauU_ib(ji,jj) / zvel 522 zTauB = ztaux_base(ji,jj) / zvel 523 ! !--- OceanBottom-to-Ice stress 524 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 555 525 ! 556 526 ! !--- Coriolis at U-points (energy conserving formulation) 557 zCor x(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &527 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 558 528 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 559 529 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 560 530 ! 561 531 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 562 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 563 ! 564 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 565 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 532 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 533 ! 534 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 535 ! 1 = sliding friction : TauB < RHS 536 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 566 537 ! 567 538 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 568 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )& ! previous velocity569 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)570 & )/ MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast571 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0572 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin573 & ) * zmaskU(ji,jj)539 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 540 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 541 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 542 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 543 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 544 & ) * zmsk00x(ji,jj) 574 545 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 575 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) &! previous velocity576 & + zTauE + zTauO * u_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)577 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast578 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0579 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) ) &! v_ice = v_oce/100 if mass < zmmin & conc < zamin580 & ) * zmaskU(ji,jj)546 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 547 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 548 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 549 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 550 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 551 & ) * zmsk00x(ji,jj) 581 552 ENDIF 582 553 END DO … … 588 559 CALL agrif_interp_ice( 'U' ) 589 560 #endif 590 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'U' )561 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 591 562 ! 592 563 ELSE ! odd iterations … … 602 573 ! !--- tau_bottom/u_ice 603 574 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 604 zTauB = - zTauU_ib(ji,jj) / zvel 575 zTauB = ztaux_base(ji,jj) / zvel 576 ! !--- OceanBottom-to-Ice stress 577 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 605 578 ! 606 579 ! !--- Coriolis at U-points (energy conserving formulation) 607 zCor x(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &580 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 608 581 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 609 582 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 610 583 ! 611 584 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 612 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 613 ! 614 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 615 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 585 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 586 ! 587 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 588 ! 1 = sliding friction : TauB < RHS 589 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 616 590 ! 617 591 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 618 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )& ! previous velocity619 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)620 & )/ MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast621 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0622 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin623 & ) * zmaskU(ji,jj)592 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 593 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 594 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 595 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 596 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 597 & ) * zmsk00x(ji,jj) 624 598 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 625 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) &! previous velocity626 & + zTauE + zTauO * u_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)627 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast628 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0629 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) ) &! v_ice = v_oce/100 if mass < zmmin & conc < zamin630 & ) * zmaskU(ji,jj)599 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 600 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 601 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 602 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 603 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 604 & ) * zmsk00x(ji,jj) 631 605 ENDIF 632 606 END DO … … 638 612 CALL agrif_interp_ice( 'U' ) 639 613 #endif 640 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'U' )614 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 641 615 ! 642 616 DO jj = 2, jpjm1 … … 650 624 ! !--- tau_bottom/v_ice 651 625 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 652 zTauB = - zTauV_ib(ji,jj) / zvel 626 zTauB = ztauy_base(ji,jj) / zvel 627 ! !--- OceanBottom-to-Ice stress 628 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 653 629 ! 654 630 ! !--- Coriolis at v-points (energy conserving formulation) 655 zCor y(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &631 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 656 632 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 657 633 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 658 634 ! 659 635 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 660 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 661 ! 662 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 663 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 636 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 637 ! 638 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 639 ! 1 = sliding friction : TauB < RHS 640 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 664 641 ! 665 642 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 666 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )& ! previous velocity667 & + zTauE + zTauO * v_ice(ji,jj)& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)668 & )/ MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast669 &+ ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0670 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin671 & ) * zmaskV(ji,jj)643 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 644 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 645 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 646 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 647 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 648 & ) * zmsk00y(ji,jj) 672 649 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 673 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) &! previous velocity674 & + zTauE + zTauO * v_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)675 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast676 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0677 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) ) &! v_ice = v_oce/100 if mass < zmmin & conc < zamin678 & ) * zmaskV(ji,jj)650 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 651 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 652 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 653 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 654 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 655 & ) * zmsk00y(ji,jj) 679 656 ENDIF 680 657 END DO … … 686 663 CALL agrif_interp_ice( 'V' ) 687 664 #endif 688 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'V' )665 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 689 666 ! 690 667 ENDIF … … 701 678 END DO ! end loop over jter ! 702 679 ! ! ==================== ! 703 !704 IF( ln_bdy .AND. .NOT.ll_bdy_substep ) THEN705 CALL bdy_ice_dyn( 'U' )706 CALL bdy_ice_dyn( 'V' )707 ENDIF708 680 ! 709 681 !------------------------------------------------------------------------------! … … 764 736 DO jj = 1, jpj 765 737 DO ji = 1, jpi 766 z swi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice738 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 767 739 END DO 768 740 END DO 769 741 742 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 743 IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 744 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 745 ! 746 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 747 & ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 748 ! 749 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 750 CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 751 CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 752 CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 753 CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 754 CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 755 ENDIF 756 770 757 ! --- divergence, shear and strength --- ! 771 IF( iom_use('icediv') ) CALL iom_put( "icediv" , pdivu_i (:,:) * zswi(:,:)) ! divergence772 IF( iom_use('iceshe') ) CALL iom_put( "iceshe" , pshear_i(:,:) * zswi(:,:)) ! shear773 IF( iom_use('icestr') ) CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) ) ! Icestrength774 775 ! --- charge ellipse--- !776 IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN758 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence 759 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear 760 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength 761 762 ! --- stress tensor --- ! 763 IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN 777 764 ! 778 765 ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) … … 780 767 DO jj = 2, jpjm1 781 768 DO ji = 2, jpim1 782 zdum1 = ( z swi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point783 & z swi(ji ,jj) * pstress12_i(ji ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) &784 & / MAX( 1._wp, z swi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) )769 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 770 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 771 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 785 772 786 773 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 787 774 788 zdum2 = z swi(ji,jj) / MAX( 1._wp, strength(ji,jj) )775 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 789 776 790 777 !! zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) … … 799 786 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 800 787 ! 801 IF( iom_use('isig1') ) CALL iom_put( "isig1" , zsig1 ) 802 IF( iom_use('isig2') ) CALL iom_put( "isig2" , zsig2 ) 803 IF( iom_use('isig3') ) CALL iom_put( "isig3" , zsig3 ) 804 ! 788 CALL iom_put( 'isig1' , zsig1 ) 789 CALL iom_put( 'isig2' , zsig2 ) 790 CALL iom_put( 'isig3' , zsig3 ) 791 ! 792 ! Stress tensor invariants (normal and shear stress N/m) 793 IF( iom_use('normstr') ) CALL iom_put( 'normstr' , ( zs1(:,:) + zs2(:,:) ) * zmsk00(:,:) ) ! Normal stress 794 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 795 805 796 DEALLOCATE( zsig1 , zsig2 , zsig3 ) 806 797 ENDIF 807 798 808 799 ! --- SIMIP --- ! 809 IF ( iom_use( 'normstr' ) .OR. iom_use( 'sheastr' ) .OR. iom_use( 'dssh_dx' ) .OR. iom_use( 'dssh_dy' ) .OR. & 810 & iom_use( 'corstrx' ) .OR. iom_use( 'corstry' ) .OR. iom_use( 'intstrx' ) .OR. iom_use( 'intstry' ) .OR. & 811 & iom_use( 'utau_oi' ) .OR. iom_use( 'vtau_oi' ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. & 812 & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp' ) .OR. iom_use( 'yatrp' ) ) THEN 813 814 ALLOCATE( zdiag_sig1 (jpi,jpj) , zdiag_sig2 (jpi,jpj) , zdiag_dssh_dx (jpi,jpj) , zdiag_dssh_dy (jpi,jpj) , & 815 & zdiag_corstrx (jpi,jpj) , zdiag_corstry (jpi,jpj) , zdiag_intstrx (jpi,jpj) , zdiag_intstry (jpi,jpj) , & 816 & zdiag_utau_oi (jpi,jpj) , zdiag_vtau_oi (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 817 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp (jpi,jpj) , zdiag_yatrp (jpi,jpj) ) 818 800 IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 801 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 802 ! 803 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 804 & zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 805 806 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) 807 CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y) 808 CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x) 809 CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y) 810 CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x) 811 CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y) 812 ENDIF 813 814 IF( iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. & 815 & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN 816 ! 817 ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 818 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 819 ! 819 820 DO jj = 2, jpjm1 820 821 DO ji = 2, jpim1 821 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice822 823 ! Stress tensor invariants (normal and shear stress N/m)824 zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch ! normal stress825 zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch ! shear stress826 827 ! Stress terms of the momentum equation (N/m2)828 zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch ! sea surface slope stress term829 zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch830 831 zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch ! Coriolis stress term832 zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch833 834 zdiag_intstrx(ji,jj) = zfU(ji,jj) * rswitch ! internal stress term835 zdiag_intstry(ji,jj) = zfV(ji,jj) * rswitch836 837 zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch ! oceanic stress838 zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch839 840 822 ! 2D ice mass, snow mass, area transport arrays (X, Y) 841 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch842 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch843 823 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 824 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 825 844 826 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 845 827 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 846 828 847 829 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 848 830 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 849 831 850 832 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 851 833 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 852 853 END DO 854 END DO 855 856 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_sig1 , 'T', 1., zdiag_sig2 , 'T', 1., & 857 & zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1., & 858 & zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1., & 859 & zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1. ) 860 861 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_utau_oi , 'U', -1., zdiag_vtau_oi , 'V', -1., & 862 & zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1., & 863 & zdiag_xatrp , 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 864 & zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp , 'V', -1. ) 865 866 IF( iom_use('normstr' ) ) CALL iom_put( 'normstr' , zdiag_sig1(:,:) ) ! Normal stress 867 IF( iom_use('sheastr' ) ) CALL iom_put( 'sheastr' , zdiag_sig2(:,:) ) ! Shear stress 868 IF( iom_use('dssh_dx' ) ) CALL iom_put( 'dssh_dx' , zdiag_dssh_dx(:,:) ) ! Sea-surface tilt term in force balance (x) 869 IF( iom_use('dssh_dy' ) ) CALL iom_put( 'dssh_dy' , zdiag_dssh_dy(:,:) ) ! Sea-surface tilt term in force balance (y) 870 IF( iom_use('corstrx' ) ) CALL iom_put( 'corstrx' , zdiag_corstrx(:,:) ) ! Coriolis force term in force balance (x) 871 IF( iom_use('corstry' ) ) CALL iom_put( 'corstry' , zdiag_corstry(:,:) ) ! Coriolis force term in force balance (y) 872 IF( iom_use('intstrx' ) ) CALL iom_put( 'intstrx' , zdiag_intstrx(:,:) ) ! Internal force term in force balance (x) 873 IF( iom_use('intstry' ) ) CALL iom_put( 'intstry' , zdiag_intstry(:,:) ) ! Internal force term in force balance (y) 874 IF( iom_use('utau_oi' ) ) CALL iom_put( 'utau_oi' , zdiag_utau_oi(:,:) ) ! Ocean stress term in force balance (x) 875 IF( iom_use('vtau_oi' ) ) CALL iom_put( 'vtau_oi' , zdiag_vtau_oi(:,:) ) ! Ocean stress term in force balance (y) 876 IF( iom_use('xmtrpice') ) CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice(:,:) ) ! X-component of sea-ice mass transport (kg/s) 877 IF( iom_use('ymtrpice') ) CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice(:,:) ) ! Y-component of sea-ice mass transport 878 IF( iom_use('xmtrpsnw') ) CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw(:,:) ) ! X-component of snow mass transport (kg/s) 879 IF( iom_use('ymtrpsnw') ) CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw(:,:) ) ! Y-component of snow mass transport 880 IF( iom_use('xatrp' ) ) CALL iom_put( 'xatrp' , zdiag_xatrp(:,:) ) ! X-component of ice area transport 881 IF( iom_use('yatrp' ) ) CALL iom_put( 'yatrp' , zdiag_yatrp(:,:) ) ! Y-component of ice area transport 882 883 DEALLOCATE( zdiag_sig1 , zdiag_sig2 , zdiag_dssh_dx , zdiag_dssh_dy , & 884 & zdiag_corstrx , zdiag_corstry , zdiag_intstrx , zdiag_intstry , & 885 & zdiag_utau_oi , zdiag_vtau_oi , zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 886 & zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 834 835 END DO 836 END DO 837 838 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 839 & zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 840 & zdiag_xatrp , 'U', -1., zdiag_yatrp , 'V', -1. ) 841 842 CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s) 843 CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice ) ! Y-component of sea-ice mass transport 844 CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw ) ! X-component of snow mass transport (kg/s) 845 CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw ) ! Y-component of snow mass transport 846 CALL iom_put( 'xatrp' , zdiag_xatrp ) ! X-component of ice area transport 847 CALL iom_put( 'yatrp' , zdiag_yatrp ) ! Y-component of ice area transport 848 849 DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 850 & zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 887 851 888 852 ENDIF -
NEMO/trunk/src/ICE/iceistate.F90
r11229 r11536 22 22 USE eosbn2 ! equation of state 23 23 USE domvvl ! Variable volume 24 USE ice ! sea-ice variables 25 USE icevar ! ice_var_salprof 24 USE ice ! sea-ice: variables 25 USE ice1D ! sea-ice: thermodynamics variables 26 USE icetab ! sea-ice: 1D <==> 2D transformation 27 USE icevar ! sea-ice: operations 26 28 ! 27 29 USE in_out_manager ! I/O manager … … 36 38 PUBLIC ice_istate ! called by icestp.F90 37 39 PUBLIC ice_istate_init ! called by icestp.F90 38 39 INTEGER , PARAMETER :: jpfldi = 6 ! maximum number of files to read40 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) at T-point41 INTEGER , PARAMETER :: jp_hts = 2 ! index of snow thicknes (m) at T-point42 INTEGER , PARAMETER :: jp_ati = 3 ! index of ice fraction (%) at T-point43 INTEGER , PARAMETER :: jp_tsu = 4 ! index of ice surface temp (K) at T-point44 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temp at T-point45 INTEGER , PARAMETER :: jp_smi = 6 ! index of ice sali at T-point46 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read)47 40 ! 48 41 ! !! ** namelist (namini) ** 49 LOGICAL :: ln_iceini ! initialization or not 50 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file 51 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice 52 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north 53 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south 54 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north 55 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south 56 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north 57 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south 58 REAL(wp) :: rn_smi_ini_n ! initial salinity 59 REAL(wp) :: rn_smi_ini_s ! initial salinity 60 REAL(wp) :: rn_tmi_ini_n ! initial temperature 61 REAL(wp) :: rn_tmi_ini_s ! initial temperature 62 42 LOGICAL, PUBLIC :: ln_iceini !: Ice initialization or not 43 LOGICAL, PUBLIC :: ln_iceini_file !: Ice initialization from 2D netcdf file 44 REAL(wp) :: rn_thres_sst 45 REAL(wp) :: rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 46 REAL(wp) :: rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 47 REAL(wp) :: rn_apd_ini_n, rn_hpd_ini_n 48 REAL(wp) :: rn_apd_ini_s, rn_hpd_ini_s 49 ! 50 ! ! if ln_iceini_file = T 51 INTEGER , PARAMETER :: jpfldi = 9 ! maximum number of files to read 52 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) 53 INTEGER , PARAMETER :: jp_hts = 2 ! index of snw thickness (m) 54 INTEGER , PARAMETER :: jp_ati = 3 ! index of ice fraction (-) 55 INTEGER , PARAMETER :: jp_smi = 4 ! index of ice salinity (g/kg) 56 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temperature (K) 57 INTEGER , PARAMETER :: jp_tsu = 6 ! index of ice surface temp (K) 58 INTEGER , PARAMETER :: jp_tms = 7 ! index of snw temperature (K) 59 INTEGER , PARAMETER :: jp_apd = 8 ! index of pnd fraction (-) 60 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 ! 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 68 68 CONTAINS 69 69 70 SUBROUTINE ice_istate 70 SUBROUTINE ice_istate( kt ) 71 71 !!------------------------------------------------------------------- 72 72 !! *** ROUTINE ice_istate *** … … 87 87 !! 88 88 !! ** Notes : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 89 !! where there is no ice (clem: I do not know why, is it mandatory?)89 !! where there is no ice 90 90 !!-------------------------------------------------------------------- 91 INTEGER, INTENT(in) :: kt ! time step 92 !! 91 93 INTEGER :: ji, jj, jk, jl ! dummy loop indices 92 INTEGER :: i_hemis, i_fill, jl0 ! local integers 93 REAL(wp) :: ztmelts, zdh 94 REAL(wp) :: zarg, zV, zconv, zdv, zfac 94 REAL(wp) :: ztmelts 95 95 INTEGER , DIMENSION(4) :: itest 96 96 REAL(wp), DIMENSION(jpi,jpj) :: z2d 97 97 REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator 98 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 99 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini , za_i_ini !data by cattegories to fill 98 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file 99 REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 100 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini !data from namelist or nc file 101 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays 102 !! 103 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 101 104 !-------------------------------------------------------------------- 102 105 … … 105 108 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 106 109 107 !-------------------------------------------------------------------- 108 ! 1) Set surface and bottom temperatures to initial values 109 !-------------------------------------------------------------------- 110 ! 111 ! init surface temperature 110 !--------------------------- 111 ! 1) 1st init. of the fields 112 !--------------------------- 113 ! 114 ! basal temperature (considered at freezing point) [Kelvin] 115 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 116 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 117 ! 118 ! surface temperature and conductivity 112 119 DO jl = 1, jpl 113 120 t_su (:,:,jl) = rt0 * tmask(:,:,1) ! temp at the surface … … 115 122 END DO 116 123 ! 117 ! init basal temperature (considered at freezing point) [Kelvin] 118 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 119 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 120 124 ! ice and snw temperatures 125 DO jl = 1, jpl 126 DO jk = 1, nlay_i 127 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 128 END DO 129 DO jk = 1, nlay_s 130 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 131 END DO 132 END DO 133 ! 134 ! specific temperatures for coupled runs 135 tn_ice (:,:,:) = t_i (:,:,1,:) 136 t1_ice (:,:,:) = t_i (:,:,1,:) 137 138 ! heat contents 139 e_i (:,:,:,:) = 0._wp 140 e_s (:,:,:,:) = 0._wp 141 142 ! general fields 143 a_i (:,:,:) = 0._wp 144 v_i (:,:,:) = 0._wp 145 v_s (:,:,:) = 0._wp 146 sv_i(:,:,:) = 0._wp 147 oa_i(:,:,:) = 0._wp 148 ! 149 h_i (:,:,:) = 0._wp 150 h_s (:,:,:) = 0._wp 151 s_i (:,:,:) = 0._wp 152 o_i (:,:,:) = 0._wp 153 ! 154 ! melt ponds 155 a_ip (:,:,:) = 0._wp 156 v_ip (:,:,:) = 0._wp 157 a_ip_frac(:,:,:) = 0._wp 158 h_ip (:,:,:) = 0._wp 159 ! 160 ! ice velocities 161 u_ice (:,:) = 0._wp 162 v_ice (:,:) = 0._wp 163 ! 164 !------------------------------------------------------------------------ 165 ! 2) overwrite some of the fields with namelist parameters or netcdf file 166 !------------------------------------------------------------------------ 121 167 IF( ln_iceini ) THEN 122 !-----------------------------------------------------------123 ! 2) Compute or read sea ice variables ===> single category124 !-----------------------------------------------------------125 !126 168 ! !---------------! 127 169 IF( ln_iceini_file )THEN ! Read a file ! 128 170 ! !---------------! 129 ! 130 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 131 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 132 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 133 zts_u_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 134 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 135 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 136 ! 137 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 138 ELSEWHERE ; zswitch(:,:) = 0._wp 171 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 172 ELSEWHERE ; zswitch(:,:) = 0._wp 139 173 END WHERE 140 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 141 ! 174 ! 175 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 176 ! 177 ! -- mandatory fields -- ! 178 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 179 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 180 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 181 182 ! -- optional fields -- ! 183 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 184 ! 185 ! ice salinity 186 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 187 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 188 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 189 ! 190 ! ice temperature 191 IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) & 192 & si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 193 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 194 ! 195 ! surface temperature => set to ice temperature if it exists 196 IF ( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 197 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 198 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 199 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 200 ENDIF 201 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 202 ! 203 ! snow temperature => set to ice temperature if it exists 204 IF ( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 205 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 206 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 207 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 208 ENDIF 209 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 210 ! 211 ! pond concentration 212 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 213 & 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. 214 & * si(jp_ati)%fnow(:,:,1) 215 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 216 ! 217 ! pond depth 218 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 219 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 220 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 221 ! 222 ! change the switch for the following 223 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 224 ELSEWHERE ; zswitch(:,:) = 0._wp 225 END WHERE 142 226 ! !---------------! 143 227 ELSE ! Read namelist ! 144 228 ! !---------------! 145 ! no ice if sst <= t-freez + ttest229 ! no ice if (sst - Tfreez) >= thresold 146 230 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 147 231 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) … … 153 237 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 154 238 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 155 zts_u_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)156 239 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 157 240 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 241 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 242 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 243 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 244 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 158 245 ELSEWHERE 159 246 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 160 247 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 161 248 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 162 zts_u_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)163 249 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 164 250 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 251 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 252 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 253 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 254 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 165 255 END WHERE 166 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 167 ! 256 ! 257 ENDIF 258 259 ! make sure ponds = 0 if no ponds scheme 260 IF ( .NOT.ln_pnd ) THEN 261 zapnd_ini(:,:) = 0._wp 262 zhpnd_ini(:,:) = 0._wp 168 263 ENDIF 169 264 170 !------------------------------------------------------------------ 171 ! 3) Distribute ice concentration and thickness into the categories 172 !------------------------------------------------------------------ 173 ! a gaussian distribution for ice concentration is used 174 ! then we check whether the distribution fullfills 175 ! volume and area conservation, positivity and ice categories bounds 176 177 IF( jpl == 1 ) THEN 178 ! 179 zh_i_ini(:,:,1) = zht_i_ini(:,:) 180 za_i_ini(:,:,1) = zat_i_ini(:,:) 181 ! 182 ELSE 183 zh_i_ini(:,:,:) = 0._wp 184 za_i_ini(:,:,:) = 0._wp 185 ! 265 !-------------! 266 ! fill fields ! 267 !-------------! 268 ! select ice covered grid points 269 npti = 0 ; nptidx(:) = 0 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 273 npti = npti + 1 274 nptidx(npti) = (jj - 1) * jpi + ji 275 ENDIF 276 END DO 277 END DO 278 279 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 280 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 281 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 282 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 283 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 284 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 285 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 286 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 287 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 288 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 289 290 ! allocate temporary arrays 291 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 292 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 293 294 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 295 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 296 & zhi_2d , zhs_2d , zai_2d , & 297 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 298 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 299 300 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 301 DO jl = 1, jpl 302 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 303 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 304 END DO 305 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 306 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 307 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 308 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 309 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 310 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 311 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 312 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 313 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 314 315 ! deallocate temporary arrays 316 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 317 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 318 319 ! calculate extensive and intensive variables 320 CALL ice_var_salprof ! for sz_i 321 DO jl = 1, jpl 186 322 DO jj = 1, jpj 187 323 DO ji = 1, jpi 188 ! 189 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 190 191 ! find which category (jl0) the input ice thickness falls into 192 jl0 = jpl 193 DO jl = 1, jpl 194 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 195 jl0 = jl 196 CYCLE 197 ENDIF 198 END DO 199 ! 200 itest(:) = 0 201 i_fill = jpl + 1 !------------------------------------ 202 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 203 ! !------------------------------------ 204 i_fill = i_fill - 1 205 ! 206 zh_i_ini(ji,jj,:) = 0._wp 207 za_i_ini(ji,jj,:) = 0._wp 208 itest(:) = 0 209 ! 210 IF ( i_fill == 1 ) THEN !-- case very thin ice: fill only category 1 211 zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 212 za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 213 ELSE !-- case ice is thicker: fill categories >1 214 ! thickness 215 DO jl = 1, i_fill-1 216 zh_i_ini(ji,jj,jl) = hi_mean(jl) 217 END DO 218 ! 219 ! concentration 220 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 221 DO jl = 1, i_fill - 1 222 IF( jl /= jl0 )THEN 223 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 224 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 225 ENDIF 226 END DO 227 228 ! last category 229 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 230 zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 231 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 232 233 ! correction if concentration of upper cat is greater than lower cat 234 ! (it should be a gaussian around jl0 but sometimes it is not) 235 IF ( jl0 /= jpl ) THEN 236 DO jl = jpl, jl0+1, -1 237 IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 238 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 239 zh_i_ini(ji,jj,jl ) = 0._wp 240 za_i_ini(ji,jj,jl ) = 0._wp 241 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1) & 242 & + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 243 END IF 244 ENDDO 245 ENDIF 246 ! 247 ENDIF 248 ! 249 ! Compatibility tests 250 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) ! Test 1: area conservation 251 IF ( zconv < epsi06 ) itest(1) = 1 252 ! 253 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & ! Test 2: volume conservation 254 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 255 IF ( zconv < epsi06 ) itest(2) = 1 256 ! 257 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 ? 258 ! 259 itest(4) = 1 260 DO jl = 1, i_fill 261 IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 ! Test 4: positivity of ice concentrations 262 END DO 263 ! !---------------------------- 264 END DO ! end iteration on categories 265 ! !---------------------------- 266 IF( lwp .AND. SUM(itest) /= 4 ) THEN 267 WRITE(numout,*) 268 WRITE(numout,*) ' !!!! ALERT itest is not equal to 4 !!! ' 269 WRITE(numout,*) ' !!!! Something is wrong in the SI3 initialization procedure ' 270 WRITE(numout,*) 271 WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 272 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 273 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 274 ENDIF 275 ! 276 ENDIF 277 ! 324 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 325 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 326 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 278 327 END DO 279 328 END DO 280 ENDIF 281 282 !--------------------------------------------------------------------- 283 ! 4) Fill in sea ice arrays 284 !--------------------------------------------------------------------- 285 ! 286 ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 287 DO jl = 1, jpl ! loop over categories 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini(ji,jj,jl) ! concentration 291 h_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(ji,jj,jl) ! ice thickness 292 s_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) ! salinity 293 o_i(ji,jj,jl) = 0._wp ! age (0 day) 294 t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 295 ! 296 IF( zht_i_ini(ji,jj) > 0._wp )THEN 297 h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) ) ! snow depth 298 ELSE 299 h_s(ji,jj,jl)= 0._wp 300 ENDIF 301 ! 302 ! This case below should not be used if (h_s/h_i) is ok in namelist 303 ! In case snow load is in excess that would lead to transformation from snow to ice 304 ! Then, transfer the snow excess into the ice (different from icethd_dh) 305 zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 ) 306 ! recompute h_i, h_s avoiding out of bounds values 307 h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 308 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos ) 309 ! 310 ! ice volume, salt content, age content 311 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) ! ice volume 312 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) ! snow volume 313 sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 314 oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl) ! age content 315 END DO 316 END DO 317 END DO 318 ! 319 IF( nn_icesal /= 2 ) THEN ! for constant salinity in time 320 CALL ice_var_salprof 321 sv_i = s_i * v_i 322 ENDIF 323 ! 324 ! Snow temperature and heat content 325 DO jk = 1, nlay_s 326 DO jl = 1, jpl ! loop over categories 329 END DO 330 ! 331 DO jl = 1, jpl 332 DO jk = 1, nlay_s 327 333 DO jj = 1, jpj 328 334 DO ji = 1, jpi 329 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 330 ! Snow energy of melting 331 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 332 ! 333 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 334 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 335 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 336 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 337 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 335 338 END DO 336 339 END DO … … 338 341 END DO 339 342 ! 340 ! Ice salinity, temperature and heat content 341 DO jk = 1, nlay_i 342 DO jl = 1, jpl ! loop over categories 343 DO jl = 1, jpl 344 DO jk = 1, nlay_i 343 345 DO jj = 1, jpj 344 346 DO ji = 1, jpi 345 t_i (ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 346 sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin 347 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 348 ! 349 ! heat content per unit volume 350 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) & 351 & + rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 ) ) & 352 & - rcp * ( ztmelts - rt0 ) ) 353 ! 354 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 355 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 347 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 348 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 349 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 350 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 351 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 352 & - rcp * ( ztmelts - rt0 ) ) 356 353 END DO 357 354 END DO 358 355 END DO 359 356 END DO 360 ! 361 tn_ice (:,:,:) = t_su (:,:,:) 362 t1_ice (:,:,:) = t_i (:,:,1,:) ! initialisation of 1st layer temp for coupled simu 363 364 ! Melt pond volume and fraction 365 IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN ; zfac = 1._wp 366 ELSE ; zfac = 0._wp 367 ENDIF 368 DO jl = 1, jpl 369 a_ip_frac(:,:,jl) = rn_apnd * zswitch(:,:) * zfac 370 h_ip (:,:,jl) = rn_hpnd * zswitch(:,:) * zfac 371 END DO 372 a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:) 373 v_ip(:,:,:) = h_ip (:,:,:) * a_ip(:,:,:) 374 ! 375 ELSE ! if ln_iceini=false 376 a_i (:,:,:) = 0._wp 377 v_i (:,:,:) = 0._wp 378 v_s (:,:,:) = 0._wp 379 sv_i (:,:,:) = 0._wp 380 oa_i (:,:,:) = 0._wp 381 h_i (:,:,:) = 0._wp 382 h_s (:,:,:) = 0._wp 383 s_i (:,:,:) = 0._wp 384 o_i (:,:,:) = 0._wp 385 ! 386 e_i(:,:,:,:) = 0._wp 387 e_s(:,:,:,:) = 0._wp 388 ! 389 DO jl = 1, jpl 390 DO jk = 1, nlay_i 391 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 392 END DO 393 DO jk = 1, nlay_s 394 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 395 END DO 396 END DO 397 398 tn_ice (:,:,:) = t_i (:,:,1,:) 399 t1_ice (:,:,:) = t_i (:,:,1,:) ! initialisation of 1st layer temp for coupled simu 400 401 a_ip(:,:,:) = 0._wp 402 v_ip(:,:,:) = 0._wp 403 a_ip_frac(:,:,:) = 0._wp 404 h_ip (:,:,:) = 0._wp 357 358 ! Melt ponds 359 WHERE( a_i > epsi10 ) 360 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 361 ELSEWHERE 362 a_ip_frac(:,:,:) = 0._wp 363 END WHERE 364 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 365 366 ! specific temperatures for coupled runs 367 tn_ice(:,:,:) = t_su(:,:,:) 368 t1_ice(:,:,:) = t_i (:,:,1,:) 405 369 ! 406 370 ENDIF ! ln_iceini 407 371 ! 408 at_i (:,:) = 0.0_wp 409 DO jl = 1, jpl 410 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 411 END DO 412 ! 413 ! --- set ice velocities --- ! 414 u_ice (:,:) = 0._wp 415 v_ice (:,:) = 0._wp 416 ! fields needed for ice_dyn_adv_umx 417 l_split_advumx(1) = .FALSE. 372 at_i(:,:) = SUM( a_i, dim=3 ) 418 373 ! 419 374 !---------------------------------------------- 420 ! 5) Snow-ice mass (case ice is fully embedded)375 ! 3) Snow-ice mass (case ice is fully embedded) 421 376 !---------------------------------------------- 422 377 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3 ) ! snow+ice mass … … 470 425 471 426 !------------------------------------ 472 ! 6) store fields at before time-step427 ! 4) store fields at before time-step 473 428 !------------------------------------ 474 429 ! it is only necessary for the 1st interpolation by Agrif … … 508 463 ! 509 464 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files 510 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_ tsu, sn_tmi, sn_smi465 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 511 466 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 512 467 ! 513 NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, & 514 & rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 515 & rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s, & 516 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir 468 NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 469 & rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 470 & rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 471 & rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 472 & rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 473 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 517 474 !!----------------------------------------------------------------------------- 518 475 ! 519 476 REWIND( numnam_ice_ref ) ! Namelist namini in reference namelist : Ice initial state 520 477 READ ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 521 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist' , lwp)478 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist' ) 522 479 REWIND( numnam_ice_cfg ) ! Namelist namini in configuration namelist : Ice initial state 523 480 READ ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 524 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist' , lwp)481 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist' ) 525 482 IF(lwm) WRITE ( numoni, namini ) 526 483 ! 527 484 slf_i(jp_hti) = sn_hti ; slf_i(jp_hts) = sn_hts 528 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu 529 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_smi) = sn_smi 485 slf_i(jp_ati) = sn_ati ; slf_i(jp_smi) = sn_smi 486 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_tsu) = sn_tsu ; slf_i(jp_tms) = sn_tms 487 slf_i(jp_apd) = sn_apd ; slf_i(jp_hpd) = sn_hpd 530 488 ! 531 489 IF(lwp) THEN ! control print … … 534 492 WRITE(numout,*) '~~~~~~~~~~~~~~~' 535 493 WRITE(numout,*) ' Namelist namini:' 536 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_iceini = ', ln_iceini 537 WRITE(numout,*) ' ice initialization from a netcdf file ln_iceini_file = ', ln_iceini_file 538 WRITE(numout,*) ' max delta ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 539 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n 540 WRITE(numout,*) ' initial snow thickness in the south rn_hts_ini_s = ', rn_hts_ini_s 541 WRITE(numout,*) ' initial ice thickness in the north rn_hti_ini_n = ', rn_hti_ini_n 542 WRITE(numout,*) ' initial ice thickness in the south rn_hti_ini_s = ', rn_hti_ini_s 543 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_n = ', rn_ati_ini_n 544 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_s = ', rn_ati_ini_s 545 WRITE(numout,*) ' initial ice salinity in the north rn_smi_ini_n = ', rn_smi_ini_n 546 WRITE(numout,*) ' initial ice salinity in the south rn_smi_ini_s = ', rn_smi_ini_s 547 WRITE(numout,*) ' initial ice/snw temp in the north rn_tmi_ini_n = ', rn_tmi_ini_n 548 WRITE(numout,*) ' initial ice/snw temp in the south rn_tmi_ini_s = ', rn_tmi_ini_s 494 WRITE(numout,*) ' ice initialization (T) or not (F) ln_iceini = ', ln_iceini 495 WRITE(numout,*) ' ice initialization from a netcdf file ln_iceini_file = ', ln_iceini_file 496 WRITE(numout,*) ' max ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 497 IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 498 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 499 WRITE(numout,*) ' initial ice thickness in the north-south rn_hti_ini = ', rn_hti_ini_n,rn_hti_ini_s 500 WRITE(numout,*) ' initial ice concentr in the north-south rn_ati_ini = ', rn_ati_ini_n,rn_ati_ini_s 501 WRITE(numout,*) ' initial ice salinity in the north-south rn_smi_ini = ', rn_smi_ini_n,rn_smi_ini_s 502 WRITE(numout,*) ' initial surf temperat in the north-south rn_tsu_ini = ', rn_tsu_ini_n,rn_tsu_ini_s 503 WRITE(numout,*) ' initial ice temperat in the north-south rn_tmi_ini = ', rn_tmi_ini_n,rn_tmi_ini_s 504 WRITE(numout,*) ' initial snw temperat in the north-south rn_tms_ini = ', rn_tms_ini_n,rn_tms_ini_s 505 WRITE(numout,*) ' initial pnd fraction in the north-south rn_apd_ini = ', rn_apd_ini_n,rn_apd_ini_s 506 WRITE(numout,*) ' initial pnd depth in the north-south rn_hpd_ini = ', rn_hpd_ini_n,rn_hpd_ini_s 507 ENDIF 549 508 ENDIF 550 509 ! … … 554 513 ALLOCATE( si(jpfldi), STAT=ierror ) 555 514 IF( ierror > 0 ) THEN 556 CALL ctl_stop( ' Ice_ini in iceistate: unable to allocate si structure' ) ; RETURN515 CALL ctl_stop( 'ice_istate_ini in iceistate: unable to allocate si structure' ) ; RETURN 557 516 ENDIF 558 517 ! 559 518 DO ifpr = 1, jpfldi 560 519 ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) 561 ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )520 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 562 521 END DO 563 522 ! 564 523 ! fill si with slf_i and control print 565 CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' ) 566 ! 567 CALL fld_read( nit000, 1, si ) ! input fields provided at the current time-step 568 ! 524 CALL fld_fill( si, slf_i, cn_dir, 'ice_istate_ini', 'initialization of sea ice fields', 'numnam_ice' ) 525 ! 526 ENDIF 527 ! 528 IF( .NOT.ln_pnd ) THEN 529 rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 530 rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 531 CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 569 532 ENDIF 570 533 ! -
NEMO/trunk/src/ICE/iceitd.F90
r10994 r11536 88 88 89 89 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 90 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 90 91 91 92 !----------------------------------------------------------------------------------------------- … … 316 317 ! 317 318 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 319 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 318 320 ! 319 321 END SUBROUTINE ice_itd_rem … … 586 588 ! 587 589 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 590 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 588 591 ! 589 592 jdonor(:,:) = 0 … … 664 667 ! 665 668 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 669 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 666 670 ! 667 671 END SUBROUTINE ice_itd_reb … … 685 689 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice 686 690 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 687 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' , lwp)691 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' ) 688 692 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 689 693 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 690 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' , lwp)694 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 691 695 IF(lwm) WRITE( numoni, namitd ) 692 696 ! -
NEMO/trunk/src/ICE/icerst.F90
r10425 r11536 14 14 !! ice_rst_read : read restart file 15 15 !!---------------------------------------------------------------------- 16 USE ice ! sea-ice variables16 USE ice ! sea-ice: variables 17 17 USE dom_oce ! ocean domain 18 USE phycst , ONLY : rt0 18 19 USE sbc_oce , ONLY : nn_fsbc, ln_cpl 19 USE icectl 20 USE iceistate ! sea-ice: initial state 21 USE icectl ! sea-ice: control 20 22 ! 21 23 USE in_out_manager ! I/O manager … … 53 55 IF( kt == nit000 ) lrst_ice = .FALSE. ! default definition 54 56 57 IF( ln_rst_list .OR. nn_stock /= -1 ) THEN 55 58 ! in order to get better performances with NetCDF format, we open and define the ice restart file 56 59 ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice 57 60 ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 58 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. n stock == nn_fsbc &61 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc & 59 62 & .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 60 63 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN … … 81 84 ENDIF 82 85 ENDIF 86 ENDIF 83 87 ! 84 88 IF( ln_icectl ) CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print … … 118 122 119 123 ! Prognostic variables 120 CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) 121 CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) 122 CALL iom_rstput( iter, nitrst, numriw, 'sv_i', sv_i ) 123 CALL iom_rstput( iter, nitrst, numriw, 'oa_i', oa_i ) 124 CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) 125 CALL iom_rstput( iter, nitrst, numriw, 't_su', t_su ) 126 ! Melt ponds 127 CALL iom_rstput( iter, nitrst, numriw, 'a_ip', a_ip ) 128 CALL iom_rstput( iter, nitrst, numriw, 'v_ip', v_ip ) 124 CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) 125 CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) 126 CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i ) 127 CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) 128 CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su ) 129 CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) 130 CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) 131 CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i ) 132 CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip ) 133 CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip ) 129 134 ! Snow enthalpy 130 135 DO jk = 1, nlay_s … … 141 146 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 142 147 END DO 143 ! ice velocity144 CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice145 CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice146 148 ! fields needed for Met Office (Jules) coupling 147 149 IF( ln_cpl ) THEN … … 169 171 INTEGER :: jk 170 172 LOGICAL :: llok 171 INTEGER :: id 1! local integer173 INTEGER :: id0, id1, id2, id3, id4 ! local integer 172 174 CHARACTER(len=25) :: znam 173 175 CHARACTER(len=2) :: zchar, zchar1 … … 184 186 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 185 187 186 CALL iom_get( numrir, 'nn_fsbc', zfice ) 187 CALL iom_get( numrir, 'kt_ice' , ziter ) 188 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 189 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 190 191 ! Control of date 192 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 193 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 194 & ' verify the file or rerun with the value 0 for the', & 195 & ' control of time parameter nrstdt' ) 196 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 197 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 198 & ' verify the file or rerun with the value 0 for the', & 199 & ' control of time parameter nrstdt' ) 200 201 ! Prognostic variables 202 CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i ) 203 CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s ) 204 CALL iom_get( numrir, jpdom_autoglo, 'sv_i', sv_i ) 205 CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 206 CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i ) 207 CALL iom_get( numrir, jpdom_autoglo, 't_su', t_su ) 208 ! Melt ponds 209 id1 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 210 IF( id1 > 0 ) THEN ! fields exist (melt ponds) 211 CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 212 CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 213 ELSE ! start from rest 214 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 215 a_ip(:,:,:) = 0._wp 216 v_ip(:,:,:) = 0._wp 217 ENDIF 218 ! Snow enthalpy 219 DO jk = 1, nlay_s 220 WRITE(zchar1,'(I2.2)') jk 221 znam = 'e_s'//'_l'//zchar1 222 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 223 e_s(:,:,jk,:) = z3d(:,:,:) 224 END DO 225 ! Ice enthalpy 226 DO jk = 1, nlay_i 227 WRITE(zchar1,'(I2.2)') jk 228 znam = 'e_i'//'_l'//zchar1 229 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 230 e_i(:,:,jk,:) = z3d(:,:,:) 231 END DO 232 ! ice velocity 233 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 234 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 235 236 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 237 238 ! fields needed for Met Office (Jules) coupling 239 IF( ln_cpl ) THEN 240 CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 241 CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice ) 188 ! test if v_i exists 189 id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 190 191 ! ! ------------------------------ ! 192 IF( id0 > 0 ) THEN ! == case of a normal restart == ! 193 ! ! ------------------------------ ! 194 195 ! Time info 196 CALL iom_get( numrir, 'nn_fsbc', zfice ) 197 CALL iom_get( numrir, 'kt_ice' , ziter ) 198 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 199 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 200 201 ! Control of date 202 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 203 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 204 & ' verify the file or rerun with the value 0 for the', & 205 & ' control of time parameter nrstdt' ) 206 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 207 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 208 & ' verify the file or rerun with the value 0 for the', & 209 & ' control of time parameter nrstdt' ) 210 211 ! --- mandatory fields --- ! 212 CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i ) 213 CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s ) 214 CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i ) 215 CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i ) 216 CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su ) 217 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 218 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 219 ! Snow enthalpy 220 DO jk = 1, nlay_s 221 WRITE(zchar1,'(I2.2)') jk 222 znam = 'e_s'//'_l'//zchar1 223 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 224 e_s(:,:,jk,:) = z3d(:,:,:) 225 END DO 226 ! Ice enthalpy 227 DO jk = 1, nlay_i 228 WRITE(zchar1,'(I2.2)') jk 229 znam = 'e_i'//'_l'//zchar1 230 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 231 e_i(:,:,jk,:) = z3d(:,:,:) 232 END DO 233 ! -- optional fields -- ! 234 ! ice age 235 id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 236 IF( id1 > 0 ) THEN ! fields exist 237 CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 238 ELSE ! start from rest 239 IF(lwp) WRITE(numout,*) ' ==>> previous run without ice age output then set it to zero' 240 oa_i(:,:,:) = 0._wp 241 ENDIF 242 ! melt ponds 243 id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 244 IF( id2 > 0 ) THEN ! fields exist 245 CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 246 CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 247 ELSE ! start from rest 248 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 249 a_ip(:,:,:) = 0._wp 250 v_ip(:,:,:) = 0._wp 251 ENDIF 252 ! fields needed for Met Office (Jules) coupling 253 IF( ln_cpl ) THEN 254 id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 255 id4 = iom_varid( numrir, 't1_ice' , ldstop = .FALSE. ) 256 IF( id3 > 0 .AND. id4 > 0 ) THEN ! fields exist 257 CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 258 CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice ) 259 ELSE ! start from rest 260 IF(lwp) WRITE(numout,*) ' ==>> previous run without conductivity output then set it to zero' 261 cnd_ice(:,:,:) = 0._wp 262 t1_ice (:,:,:) = rt0 263 ENDIF 264 ENDIF 265 266 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 267 268 ! ! ---------------------------------- ! 269 ELSE ! == case of a simplified restart == ! 270 ! ! ---------------------------------- ! 271 CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 272 ! 273 CALL ice_istate_init 274 CALL ice_istate( nit000 ) 275 ! 276 IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 277 & CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 278 ! 242 279 ENDIF 243 280 -
NEMO/trunk/src/ICE/icesbc.F90
r10535 r11536 114 114 INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk or Pure Coupled) 115 115 ! 116 INTEGER :: ji, jj, jl ! dummy loop index 117 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 118 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace 116 INTEGER :: ji, jj, jl ! dummy loop index 117 REAL(wp) :: zmiss_val ! missing value retrieved from xios 118 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 119 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zalb, zmsk00 ! 2D workspace 119 120 !!-------------------------------------------------------------------- 120 121 ! … … 126 127 WRITE(numout,*)'~~~~~~~~~~~~~~~' 127 128 ENDIF 129 130 ! get missing value from xml 131 CALL iom_miss_val( "icetemp", zmiss_val ) 128 132 129 133 ! --- cloud-sky and overcast-sky ice albedos --- ! … … 152 156 153 157 !--- output ice albedo and surface albedo ---! 154 IF( iom_use('icealb') ) THEN 155 WHERE( at_i_b <= epsi06 ) ; zalb(:,:) = rn_alb_oce 156 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 158 IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 159 160 ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 161 162 WHERE( at_i_b <= epsi06 ) 163 zmsk00(:,:) = 0._wp 164 zalb (:,:) = rn_alb_oce 165 ELSEWHERE 166 zmsk00(:,:) = 1._wp 167 zalb (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 157 168 END WHERE 158 CALL iom_put( "icealb" , zalb(:,:) )159 ENDIF160 IF( iom_use('albedo') ) THEN169 ! ice albedo 170 CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 171 ! ice+ocean albedo 161 172 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 162 CALL iom_put( "albedo" , zalb(:,:) ) 173 CALL iom_put( 'albedo' , zalb ) 174 175 DEALLOCATE( zalb, zmsk00 ) 176 163 177 ENDIF 164 178 ! … … 272 286 REWIND( numnam_ice_ref ) ! Namelist namsbc in reference namelist : Ice dynamics 273 287 READ ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901) 274 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' , lwp)288 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 275 289 REWIND( numnam_ice_cfg ) ! Namelist namsbc in configuration namelist : Ice dynamics 276 290 READ ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 277 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' , lwp)291 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 278 292 IF(lwm) WRITE( numoni, namsbc ) 279 293 ! -
NEMO/trunk/src/ICE/icestp.F90
r10994 r11536 254 254 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst 255 255 CALL ice_istate_init 256 CALL ice_istate 256 CALL ice_istate( nit000 ) 257 257 ELSE ! start from a restart file 258 258 CALL ice_rst_read … … 303 303 REWIND( numnam_ice_ref ) ! Namelist nampar in reference namelist : Parameters for ice 304 304 READ ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 305 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist' , lwp)305 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist' ) 306 306 REWIND( numnam_ice_cfg ) ! Namelist nampar in configuration namelist : Parameters for ice 307 307 READ ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 308 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist' , lwp)308 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist' ) 309 309 IF(lwm) WRITE( numoni, nampar ) 310 310 ! … … 425 425 wfx_err_sub(:,:) = 0._wp 426 426 ! 427 afx_tot(:,:) = 0._wp ;428 !429 427 diag_heat(:,:) = 0._wp ; diag_sice(:,:) = 0._wp 430 428 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp -
NEMO/trunk/src/ICE/icethd.F90
r10994 r11536 95 95 IF( ln_timing ) CALL timing_start('icethd') ! timing 96 96 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 97 IF( ln_icediachk ) CALL ice_cons2D (0, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 97 98 98 99 IF( kt == nit000 .AND. lwp ) THEN … … 243 244 ! 244 245 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 246 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 245 247 ! 246 248 IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- ! … … 539 541 REWIND( numnam_ice_ref ) ! Namelist namthd in reference namelist : Ice thermodynamics 540 542 READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 541 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist' , lwp)543 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist' ) 542 544 REWIND( numnam_ice_cfg ) ! Namelist namthd in configuration namelist : Ice thermodynamics 543 545 READ ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 544 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist' , lwp)546 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist' ) 545 547 IF(lwm) WRITE( numoni, namthd ) 546 548 ! -
NEMO/trunk/src/ICE/icethd_da.F90
r10069 r11536 179 179 REWIND( numnam_ice_ref ) ! Namelist namthd_da in reference namelist : Ice thermodynamics 180 180 READ ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 181 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist' , lwp)181 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist' ) 182 182 REWIND( numnam_ice_cfg ) ! Namelist namthd_da in configuration namelist : Ice thermodynamics 183 183 READ ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 184 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist' , lwp)184 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist' ) 185 185 IF(lwm) WRITE( numoni, namthd_da ) 186 186 ! -
NEMO/trunk/src/ICE/icethd_do.F90
r11229 r11536 113 113 114 114 IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) 115 IF( ln_icediachk ) CALL ice_cons2D ( 0, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft ) 115 116 116 117 at_i(:,:) = SUM( a_i, dim=3 ) … … 420 421 ! 421 422 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 423 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 422 424 ! 423 425 END SUBROUTINE ice_thd_do … … 443 445 REWIND( numnam_ice_ref ) ! Namelist namthd_do in reference namelist : Ice thermodynamics 444 446 READ ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 445 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist' , lwp)447 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist' ) 446 448 REWIND( numnam_ice_cfg ) ! Namelist namthd_do in configuration namelist : Ice thermodynamics 447 449 READ ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 448 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist' , lwp)450 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist' ) 449 451 IF(lwm) WRITE( numoni, namthd_do ) 450 452 ! -
NEMO/trunk/src/ICE/icethd_pnd.F90
r10532 r11536 205 205 INTEGER :: ios, ioptio ! Local integer 206 206 !! 207 NAMELIST/namthd_pnd/ ln_pnd _H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb207 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 208 208 !!------------------------------------------------------------------- 209 209 ! 210 210 REWIND( numnam_ice_ref ) ! Namelist namthd_pnd in reference namelist : Melt Ponds 211 211 READ ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 212 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist' , lwp)212 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist' ) 213 213 REWIND( numnam_ice_cfg ) ! Namelist namthd_pnd in configuration namelist : Melt Ponds 214 214 READ ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 215 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' , lwp)215 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' ) 216 216 IF(lwm) WRITE ( numoni, namthd_pnd ) 217 217 ! … … 221 221 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 222 222 WRITE(numout,*) ' Namelist namicethd_pnd:' 223 WRITE(numout,*) ' Evolutive melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 224 WRITE(numout,*) ' Prescribed melt pond fraction and depth ln_pnd_CST = ', ln_pnd_CST 225 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 226 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 227 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 223 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 224 WRITE(numout,*) ' Evolutive melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 225 WRITE(numout,*) ' Prescribed melt pond fraction and depth ln_pnd_CST = ', ln_pnd_CST 226 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 227 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 228 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 228 229 ENDIF 229 230 ! 230 231 ! !== set the choice of ice pond scheme ==! 231 232 ioptio = 0 232 nice_pnd = np_pndNO 233 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 234 IF( ln_pnd_H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12 ; ENDIF 235 IF( ioptio > 1 ) CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 233 IF( .NOT.ln_pnd ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndNO ; ENDIF 234 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 235 IF( ln_pnd_H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12 ; ENDIF 236 IF( ioptio /= 1 ) & 237 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 236 238 ! 237 239 SELECT CASE( nice_pnd ) -
NEMO/trunk/src/ICE/icethd_sal.F90
r10069 r11536 134 134 REWIND( numnam_ice_ref ) ! Namelist namthd_sal in reference namelist : Ice salinity 135 135 READ ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist' , lwp)136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist' ) 137 137 REWIND( numnam_ice_cfg ) ! Namelist namthd_sal in configuration namelist : Ice salinity 138 138 READ ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' , lwp)139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' ) 140 140 IF(lwm) WRITE ( numoni, namthd_sal ) 141 141 ! -
NEMO/trunk/src/ICE/icethd_zdf.F90
r10534 r11536 90 90 REWIND( numnam_ice_ref ) ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 91 91 READ ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 92 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' , lwp)92 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' ) 93 93 REWIND( numnam_ice_cfg ) ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 94 94 READ ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 95 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' , lwp)95 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' ) 96 96 IF(lwm) WRITE( numoni, namthd_zdf ) 97 97 ! -
NEMO/trunk/src/ICE/iceupdate.F90
r10425 r11536 198 198 ! --- salt fluxes [kg/m2/s] --- ! 199 199 ! ! sfxice = sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam 200 IF( iom_use('sfxice' ) ) CALL iom_put( "sfxice", sfx * 1.e-03 ) ! salt flux from total ice growth/melt201 IF( iom_use('sfxbog' ) ) CALL iom_put( "sfxbog", sfx_bog * 1.e-03 ) ! salt flux from bottom growth202 IF( iom_use('sfxbom' ) ) CALL iom_put( "sfxbom", sfx_bom * 1.e-03 ) ! salt flux from bottom melting203 IF( iom_use('sfxsum' ) ) CALL iom_put( "sfxsum", sfx_sum * 1.e-03 ) ! salt flux from surface melting204 IF( iom_use('sfxlam' ) ) CALL iom_put( "sfxlam", sfx_lam * 1.e-03 ) ! salt flux from lateral melting205 IF( iom_use('sfxsni' ) ) CALL iom_put( "sfxsni", sfx_sni * 1.e-03 ) ! salt flux from snow ice formation206 IF( iom_use('sfxopw' ) ) CALL iom_put( "sfxopw", sfx_opw * 1.e-03 ) ! salt flux from open water formation207 IF( iom_use('sfxdyn' ) ) CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting208 IF( iom_use('sfxbri' ) ) CALL iom_put( "sfxbri", sfx_bri * 1.e-03 ) ! salt flux from brines209 IF( iom_use('sfxres' ) ) CALL iom_put( "sfxres", sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes210 IF( iom_use('sfxsub' ) ) CALL iom_put( "sfxsub", sfx_sub * 1.e-03 ) ! salt flux from sublimation200 IF( iom_use('sfxice' ) ) CALL iom_put( 'sfxice', sfx * 1.e-03 ) ! salt flux from total ice growth/melt 201 IF( iom_use('sfxbog' ) ) CALL iom_put( 'sfxbog', sfx_bog * 1.e-03 ) ! salt flux from bottom growth 202 IF( iom_use('sfxbom' ) ) CALL iom_put( 'sfxbom', sfx_bom * 1.e-03 ) ! salt flux from bottom melting 203 IF( iom_use('sfxsum' ) ) CALL iom_put( 'sfxsum', sfx_sum * 1.e-03 ) ! salt flux from surface melting 204 IF( iom_use('sfxlam' ) ) CALL iom_put( 'sfxlam', sfx_lam * 1.e-03 ) ! salt flux from lateral melting 205 IF( iom_use('sfxsni' ) ) CALL iom_put( 'sfxsni', sfx_sni * 1.e-03 ) ! salt flux from snow ice formation 206 IF( iom_use('sfxopw' ) ) CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 ) ! salt flux from open water formation 207 IF( iom_use('sfxdyn' ) ) CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting 208 IF( iom_use('sfxbri' ) ) CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 ) ! salt flux from brines 209 IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes 210 IF( iom_use('sfxsub' ) ) CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 ) ! salt flux from sublimation 211 211 212 212 ! --- mass fluxes [kg/m2/s] --- ! 213 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce", emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice)214 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice", emp_ice ) ! emp over ice (taking into account the snow blown away from the ice)213 CALL iom_put( 'emp_oce', emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice) 214 CALL iom_put( 'emp_ice', emp_ice ) ! emp over ice (taking into account the snow blown away from the ice) 215 215 216 216 ! ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd 217 IF( iom_use('vfxice' ) ) CALL iom_put( "vfxice" , wfx_ice) ! mass flux from total ice growth/melt218 IF( iom_use('vfxbog' ) ) CALL iom_put( "vfxbog" , wfx_bog) ! mass flux from bottom growth219 IF( iom_use('vfxbom' ) ) CALL iom_put( "vfxbom" , wfx_bom) ! mass flux from bottom melt220 IF( iom_use('vfxsum' ) ) CALL iom_put( "vfxsum" , wfx_sum) ! mass flux from surface melt221 IF( iom_use('vfxlam' ) ) CALL iom_put( "vfxlam" , wfx_lam) ! mass flux from lateral melt222 IF( iom_use('vfxsni' ) ) CALL iom_put( "vfxsni" , wfx_sni) ! mass flux from snow-ice formation223 IF( iom_use('vfxopw' ) ) CALL iom_put( "vfxopw" , wfx_opw) ! mass flux from growth in open water224 IF( iom_use('vfxdyn' ) ) CALL iom_put( "vfxdyn" , wfx_dyn) ! mass flux from dynamics (ridging)225 IF( iom_use('vfxres' ) ) CALL iom_put( "vfxres" , wfx_res) ! mass flux from undiagnosed processes226 IF( iom_use('vfxpnd' ) ) CALL iom_put( "vfxpnd" , wfx_pnd) ! mass flux from melt ponds227 IF( iom_use('vfxsub' ) ) CALL iom_put( "vfxsub", wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.)228 IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub ) ! "excess" of sublimation sent to ocean229 230 IF ( iom_use( "vfxthin") ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations217 CALL iom_put( 'vfxice' , wfx_ice ) ! mass flux from total ice growth/melt 218 CALL iom_put( 'vfxbog' , wfx_bog ) ! mass flux from bottom growth 219 CALL iom_put( 'vfxbom' , wfx_bom ) ! mass flux from bottom melt 220 CALL iom_put( 'vfxsum' , wfx_sum ) ! mass flux from surface melt 221 CALL iom_put( 'vfxlam' , wfx_lam ) ! mass flux from lateral melt 222 CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation 223 CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water 224 CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging) 225 CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes 226 CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds 227 CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.) 228 CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean 229 230 IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 231 231 WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 232 232 ELSEWHERE ; z2d = 0._wp 233 233 END WHERE 234 CALL iom_put( "vfxthin", wfx_opw + z2d )235 ENDIF 236 237 ! 238 IF( iom_use('vfxsnw' ) ) CALL iom_put( "vfxsnw", wfx_snw ) ! mass flux from total snow growth/melt239 IF( iom_use('vfxsnw_sum' ) ) CALL iom_put( "vfxsnw_sum", wfx_snw_sum ) ! mass flux from snow melt at the surface240 IF( iom_use('vfxsnw_sni' ) ) CALL iom_put( "vfxsnw_sni", wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation241 IF( iom_use('vfxsnw_dyn' ) ) CALL iom_put( "vfxsnw_dyn", wfx_snw_dyn ) ! mass flux from dynamics (ridging)242 IF( iom_use('vfxsnw_sub' ) ) CALL iom_put( "vfxsnw_sub", wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.)243 IF( iom_use('vfxsnw_pre' ) ) CALL iom_put( "vfxsnw_pre", wfx_spr ) ! snow precip234 CALL iom_put( 'vfxthin', wfx_opw + z2d ) 235 ENDIF 236 237 ! ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 238 CALL iom_put( 'vfxsnw' , wfx_snw ) ! mass flux from total snow growth/melt 239 CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum ) ! mass flux from snow melt at the surface 240 CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation 241 CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn ) ! mass flux from dynamics (ridging) 242 CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.) 243 CALL iom_put( 'vfxsnw_pre' , wfx_spr ) ! snow precip 244 244 245 245 ! --- heat fluxes [W/m2] --- ! 246 246 ! ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp ) 247 IF( iom_use('qsr_oce' ) ) CALL iom_put( "qsr_oce", qsr_oce * ( 1._wp - at_i_b ) ) ! solar flux at ocean surface248 IF( iom_use('qns_oce' ) ) CALL iom_put( "qns_oce", qns_oce * ( 1._wp - at_i_b ) + qemp_oce ) ! non-solar flux at ocean surface249 IF( iom_use('qsr_ice' ) ) CALL iom_put( "qsr_ice", SUM( qsr_ice * a_i_b, dim=3 ) ) ! solar flux at ice surface250 IF( iom_use('qns_ice' ) ) CALL iom_put( "qns_ice", SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice ) ! non-solar flux at ice surface251 IF( iom_use('qtr_ice_bot') ) CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice252 IF( iom_use('qtr_ice_top') ) CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface253 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce", ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )254 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice", SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice )255 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( "qt_oce_ai", qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm)256 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( "qt_atm_oi", qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)257 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce", qemp_oce ) ! Downward Heat Flux from E-P over ocean258 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice", qemp_ice ) ! Downward Heat Flux from E-P over ice247 IF( iom_use('qsr_oce' ) ) CALL iom_put( 'qsr_oce' , qsr_oce * ( 1._wp - at_i_b ) ) ! solar flux at ocean surface 248 IF( iom_use('qns_oce' ) ) CALL iom_put( 'qns_oce' , qns_oce * ( 1._wp - at_i_b ) + qemp_oce ) ! non-solar flux at ocean surface 249 IF( iom_use('qsr_ice' ) ) CALL iom_put( 'qsr_ice' , SUM( qsr_ice * a_i_b, dim=3 ) ) ! solar flux at ice surface 250 IF( iom_use('qns_ice' ) ) CALL iom_put( 'qns_ice' , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice ) ! non-solar flux at ice surface 251 IF( iom_use('qtr_ice_bot') ) CALL iom_put( 'qtr_ice_bot', SUM( qtr_ice_bot * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice 252 IF( iom_use('qtr_ice_top') ) CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface 253 IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 254 IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice ) 255 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) 256 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 257 IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean 258 IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice 259 259 260 260 ! heat fluxes from ice transformations 261 ! 262 IF( iom_use('hfxbog' ) ) CALL iom_put ("hfxbog" , hfx_bog) ! heat flux used for ice bottom growth263 IF( iom_use('hfxbom' ) ) CALL iom_put ("hfxbom" , hfx_bom) ! heat flux used for ice bottom melt264 IF( iom_use('hfxsum' ) ) CALL iom_put ("hfxsum" , hfx_sum) ! heat flux used for ice surface melt265 IF( iom_use('hfxopw' ) ) CALL iom_put ("hfxopw" , hfx_opw) ! heat flux used for ice formation in open water266 IF( iom_use('hfxdif' ) ) CALL iom_put ("hfxdif" , hfx_dif) ! heat flux used for ice temperature change267 IF( iom_use('hfxsnw' ) ) CALL iom_put ("hfxsnw" , hfx_snw) ! heat flux used for snow melt268 IF( iom_use('hfxerr' ) ) CALL iom_put ("hfxerr" , hfx_err_dif) ! heat flux error after heat diffusion (included in qt_oce_ai)261 ! ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 262 CALL iom_put ('hfxbog' , hfx_bog ) ! heat flux used for ice bottom growth 263 CALL iom_put ('hfxbom' , hfx_bom ) ! heat flux used for ice bottom melt 264 CALL iom_put ('hfxsum' , hfx_sum ) ! heat flux used for ice surface melt 265 CALL iom_put ('hfxopw' , hfx_opw ) ! heat flux used for ice formation in open water 266 CALL iom_put ('hfxdif' , hfx_dif ) ! heat flux used for ice temperature change 267 CALL iom_put ('hfxsnw' , hfx_snw ) ! heat flux used for snow melt 268 CALL iom_put ('hfxerr' , hfx_err_dif ) ! heat flux error after heat diffusion (included in qt_oce_ai) 269 269 270 270 ! heat fluxes associated with mass exchange (freeze/melt/precip...) 271 IF( iom_use('hfxthd' ) ) CALL iom_put ("hfxthd" , hfx_thd) !272 IF( iom_use('hfxdyn' ) ) CALL iom_put ("hfxdyn" , hfx_dyn) !273 IF( iom_use('hfxres' ) ) CALL iom_put ("hfxres" , hfx_res) !274 IF( iom_use('hfxsub' ) ) CALL iom_put ("hfxsub" , hfx_sub) !275 IF( iom_use('hfxspr' ) ) CALL iom_put ("hfxspr" , hfx_spr) ! Heat flux from snow precip heat content271 CALL iom_put ('hfxthd' , hfx_thd ) ! 272 CALL iom_put ('hfxdyn' , hfx_dyn ) ! 273 CALL iom_put ('hfxres' , hfx_res ) ! 274 CALL iom_put ('hfxsub' , hfx_sub ) ! 275 CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content 276 276 277 277 ! other heat fluxes 278 IF( iom_use('hfxsensib' ) ) CALL iom_put( "hfxsensib" , -qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux 279 IF( iom_use('hfxcndbot' ) ) CALL iom_put( "hfxcndbot" , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 280 IF( iom_use('hfxcndtop' ) ) CALL iom_put( "hfxcndtop" , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 281 282 ! diags 283 IF( iom_use('hfxdhc' ) ) CALL iom_put ("hfxdhc" , diag_heat ) ! Heat content variation in snow and ice 284 ! 278 IF( iom_use('hfxsensib' ) ) CALL iom_put( 'hfxsensib' , -qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux 279 IF( iom_use('hfxcndbot' ) ) CALL iom_put( 'hfxcndbot' , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 280 IF( iom_use('hfxcndtop' ) ) CALL iom_put( 'hfxcndtop' , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 281 285 282 ! controls 286 283 !--------- … … 413 410 !! ** Method : use of IOM library 414 411 !!---------------------------------------------------------------------- 415 CHARACTER(len=*) , INTENT(in) :: cdrw ! "READ"/"WRITE"flag412 CHARACTER(len=*) , INTENT(in) :: cdrw ! 'READ'/'WRITE' flag 416 413 INTEGER, OPTIONAL, INTENT(in) :: kt ! ice time-step 417 414 ! -
NEMO/trunk/src/ICE/icevar.F90
r11229 r11536 32 32 !! - vt_s(jpi,jpj) 33 33 !! - at_i(jpi,jpj) 34 !! - st_i(jpi,jpj) 34 35 !! - et_s(jpi,jpj) total snow heat content 35 36 !! - et_i(jpi,jpj) total ice thermal content … … 46 47 !! ice_var_zapneg : remove negative ice fields 47 48 !! ice_var_roundoff : remove negative values arising from roundoff erros 48 !! ice_var_itd : convert 1-cat to jpl-cat49 !! ice_var_itd2 : convert N-cat to jpl-cat50 49 !! ice_var_bv : brine volume 51 50 !! ice_var_enthalpy : compute ice and snow enthalpies from temperature 52 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 !! ice_var_itd : convert N-cat to M-cat 53 53 !!---------------------------------------------------------------------- 54 54 USE dom_oce ! ocean space and time domain … … 104 104 ! 105 105 ! ! integrated values 106 vt_i(:,:) = SUM( v_i(:,:,:) , dim=3 ) 107 vt_s(:,:) = SUM( v_s(:,:,:) , dim=3 ) 108 at_i(:,:) = SUM( a_i(:,:,:) , dim=3 ) 109 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 110 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 106 vt_i(:,:) = SUM( v_i (:,:,:) , dim=3 ) 107 vt_s(:,:) = SUM( v_s (:,:,:) , dim=3 ) 108 st_i(:,:) = SUM( sv_i(:,:,:) , dim=3 ) 109 at_i(:,:) = SUM( a_i (:,:,:) , dim=3 ) 110 et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 111 et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 111 112 ! 112 113 at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds … … 138 139 tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 139 140 om_i (:,:) = SUM( oa_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 140 sm_i (:,:) = SUM( sv_i(:,:,:) , dim=3 )* z1_vt_i(:,:)141 sm_i (:,:) = st_i(:,:) * z1_vt_i(:,:) 141 142 ! 142 143 tm_i(:,:) = 0._wp … … 158 159 tm_s (:,:) = rt0 159 160 END WHERE 160 161 ! 162 ! ! mean melt pond depth 163 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 164 ELSEWHERE ; hm_ip(:,:) = 0._wp 165 END WHERE 166 ! 161 167 DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 168 ! 162 169 ENDIF 163 170 ! … … 263 270 ! 264 271 ! integrated values 265 vt_i (:,:) = SUM( v_i , dim=3 )266 vt_s (:,:) = SUM( v_s , dim=3 )267 at_i (:,:) = SUM( a_i , dim=3 )272 vt_i (:,:) = SUM( v_i , dim=3 ) 273 vt_s (:,:) = SUM( v_s , dim=3 ) 274 at_i (:,:) = SUM( a_i , dim=3 ) 268 275 ! 269 276 END SUBROUTINE ice_var_glo2eqv … … 533 540 534 541 ! to be sure that at_i is the sum of a_i(jl) 535 at_i (:,:) = SUM( a_i(:,:,:), dim=3 ) 536 vt_i (:,:) = SUM( v_i(:,:,:), dim=3 ) 542 at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) 543 vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) 544 !!clem add? 545 ! vt_s (:,:) = SUM( v_s (:,:,:), dim=3 ) 546 ! st_i (:,:) = SUM( sv_i(:,:,:), dim=3 ) 547 ! et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 548 ! et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 549 !!clem 537 550 538 551 ! open water = 1 if at_i=0 … … 652 665 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 653 666 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 654 IF 667 IF( ln_pnd_H12 ) THEN 655 668 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 656 669 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 … … 773 786 !! ** Purpose : converting N-cat ice to jpl ice categories 774 787 !!------------------------------------------------------------------- 775 SUBROUTINE ice_var_itd_1c1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 788 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 789 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 776 790 !!------------------------------------------------------------------- 777 791 !! ** Purpose : converting 1-cat ice to 1 ice category 778 792 !!------------------------------------------------------------------- 779 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables 780 REAL(wp), DIMENSION(:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables 781 !!------------------------------------------------------------------- 782 zh_i(:) = zhti(:) 783 zh_s(:) = zhts(:) 784 za_i(:) = zati(:) 793 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 794 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 795 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 796 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 797 !!------------------------------------------------------------------- 798 ! == thickness and concentration == ! 799 ph_i(:) = phti(:) 800 ph_s(:) = phts(:) 801 pa_i(:) = pati(:) 802 ! 803 ! == temperature and salinity and ponds == ! 804 pt_i (:) = ptmi (:) 805 pt_s (:) = ptms (:) 806 pt_su(:) = ptmsu(:) 807 ps_i (:) = psmi (:) 808 pa_ip(:) = patip(:) 809 ph_ip(:) = phtip(:) 810 785 811 END SUBROUTINE ice_var_itd_1c1c 786 812 787 SUBROUTINE ice_var_itd_Nc1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 813 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 814 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 788 815 !!------------------------------------------------------------------- 789 816 !! ** Purpose : converting N-cat ice to 1 ice category 790 817 !!------------------------------------------------------------------- 791 REAL(wp), DIMENSION(:,:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables 792 REAL(wp), DIMENSION(:) , INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables 793 !!------------------------------------------------------------------- 794 ! 795 za_i(:) = SUM( zati(:,:), dim=2 ) 796 ! 797 WHERE( za_i(:) /= 0._wp ) 798 zh_i(:) = SUM( zhti(:,:) * zati(:,:), dim=2 ) / za_i(:) 799 zh_s(:) = SUM( zhts(:,:) * zati(:,:), dim=2 ) / za_i(:) 800 ELSEWHERE 801 zh_i(:) = 0._wp 802 zh_s(:) = 0._wp 818 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 819 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 820 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 821 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 822 ! 823 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs 824 ! 825 INTEGER :: idim 826 !!------------------------------------------------------------------- 827 ! 828 idim = SIZE( phti, 1 ) 829 ! 830 ! == thickness and concentration == ! 831 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim) ) 832 ! 833 pa_i(:) = SUM( pati(:,:), dim=2 ) 834 835 WHERE( ( pa_i(:) ) /= 0._wp ) ; z1_ai(:) = 1._wp / pa_i(:) 836 ELSEWHERE ; z1_ai(:) = 0._wp 803 837 END WHERE 838 839 ph_i(:) = SUM( phti(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 840 ph_s(:) = SUM( phts(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 841 ! 842 ! == temperature and salinity == ! 843 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 844 ELSEWHERE ; z1_vi(:) = 0._wp 845 END WHERE 846 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 847 ELSEWHERE ; z1_vs(:) = 0._wp 848 END WHERE 849 pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 850 pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 851 pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 852 ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 853 854 ! == ponds == ! 855 pa_ip(:) = SUM( patip(:,:), dim=2 ) 856 WHERE( pa_ip(:) /= 0._wp ) ; ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 857 ELSEWHERE ; ph_ip(:) = 0._wp 858 END WHERE 859 ! 860 DEALLOCATE( z1_ai, z1_vi, z1_vs ) 804 861 ! 805 862 END SUBROUTINE ice_var_itd_Nc1c 806 863 807 SUBROUTINE ice_var_itd_1cMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 864 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 865 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 808 866 !!------------------------------------------------------------------- 809 867 !! … … 826 884 !! 4) Iterate until ok (SUM(itest(:) = 4) 827 885 !! 828 !! ** Arguments : zhti: 1-cat ice thickness829 !! zhts: 1-cat snow depth830 !! zati: 1-cat ice concentration886 !! ** Arguments : phti: 1-cat ice thickness 887 !! phts: 1-cat snow depth 888 !! pati: 1-cat ice concentration 831 889 !! 832 890 !! ** Output : jpl-cat … … 834 892 !! (Example of application: BDY forcings when input are cell averaged) 835 893 !!------------------------------------------------------------------- 836 INTEGER :: ji, jk, jl ! dummy loop indices 837 INTEGER :: idim, i_fill, jl0 838 REAL(wp) :: zarg, zV, zconv, zdh, zdv 839 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables 840 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables 841 INTEGER , DIMENSION(4) :: itest 842 !!------------------------------------------------------------------- 843 ! 844 ! ---------------------------------------- 894 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 895 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 896 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 897 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 898 ! 899 INTEGER , DIMENSION(4) :: itest 900 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra 901 INTEGER :: ji, jk, jl 902 INTEGER :: idim, i_fill, jl0 903 REAL(wp) :: zarg, zV, zconv, zdh, zdv 904 !!------------------------------------------------------------------- 905 ! 906 ! == thickness and concentration == ! 845 907 ! distribution over the jpl ice categories 846 ! ----------------------------------------847 ! a gaussian distribution for ice concentration is used848 ! then we check whether the distribution fullfills849 ! volume and area conservation, positivity and ice categories bounds850 idim = SIZE( zhti , 1 )851 zh_i(1:idim,1:jpl) = 0._wp852 zh_s(1:idim,1:jpl) = 0._wp853 za_i(1:idim,1:jpl) = 0._wp908 ! a gaussian distribution for ice concentration is used 909 ! then we check whether the distribution fullfills 910 ! volume and area conservation, positivity and ice categories bounds 911 idim = SIZE( phti , 1 ) 912 ! 913 ph_i(1:idim,1:jpl) = 0._wp 914 ph_s(1:idim,1:jpl) = 0._wp 915 pa_i(1:idim,1:jpl) = 0._wp 854 916 ! 855 917 DO ji = 1, idim 856 918 ! 857 IF( zhti(ji) > 0._wp ) THEN919 IF( phti(ji) > 0._wp ) THEN 858 920 ! 859 921 ! find which category (jl0) the input ice thickness falls into 860 922 jl0 = jpl 861 923 DO jl = 1, jpl 862 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN924 IF ( ( phti(ji) >= hi_max(jl-1) ) .AND. ( phti(ji) < hi_max(jl) ) ) THEN 863 925 jl0 = jl 864 926 CYCLE … … 872 934 i_fill = i_fill - 1 873 935 ! 874 zh_i(ji,1:jpl) = 0._wp875 za_i(ji,1:jpl) = 0._wp936 ph_i(ji,1:jpl) = 0._wp 937 pa_i(ji,1:jpl) = 0._wp 876 938 itest(:) = 0 877 939 ! 878 940 IF ( i_fill == 1 ) THEN !-- case very thin ice: fill only category 1 879 zh_i(ji,1) = zhti(ji)880 za_i (ji,1) = zati (ji)941 ph_i(ji,1) = phti(ji) 942 pa_i(ji,1) = pati (ji) 881 943 ELSE !-- case ice is thicker: fill categories >1 882 944 ! thickness 883 945 DO jl = 1, i_fill - 1 884 zh_i(ji,jl) = hi_mean(jl)946 ph_i(ji,jl) = hi_mean(jl) 885 947 END DO 886 948 ! 887 949 ! concentration 888 za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl))950 pa_i(ji,jl0) = pati(ji) / SQRT(REAL(jpl)) 889 951 DO jl = 1, i_fill - 1 890 952 IF ( jl /= jl0 ) THEN 891 zarg = ( zh_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )892 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2)953 zarg = ( ph_i(ji,jl) - phti(ji) ) / ( phti(ji) * 0.5_wp ) 954 pa_i(ji,jl) = pa_i (ji,jl0) * EXP(-zarg**2) 893 955 ENDIF 894 956 END DO 895 957 ! 896 958 ! last category 897 za_i(ji,i_fill) = zati(ji) - SUM( za_i(ji,1:i_fill-1) )898 zV = SUM( za_i(ji,1:i_fill-1) * zh_i(ji,1:i_fill-1) )899 zh_i(ji,i_fill) = ( zhti(ji) * zati(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )959 pa_i(ji,i_fill) = pati(ji) - SUM( pa_i(ji,1:i_fill-1) ) 960 zV = SUM( pa_i(ji,1:i_fill-1) * ph_i(ji,1:i_fill-1) ) 961 ph_i(ji,i_fill) = ( phti(ji) * pati(ji) - zV ) / MAX( pa_i(ji,i_fill), epsi10 ) 900 962 ! 901 963 ! correction if concentration of upper cat is greater than lower cat … … 903 965 IF ( jl0 /= jpl ) THEN 904 966 DO jl = jpl, jl0+1, -1 905 IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN906 zdv = zh_i(ji,jl) * za_i(ji,jl)907 zh_i(ji,jl ) = 0._wp908 za_i (ji,jl ) = 0._wp909 za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )967 IF ( pa_i(ji,jl) > pa_i(ji,jl-1) ) THEN 968 zdv = ph_i(ji,jl) * pa_i(ji,jl) 969 ph_i(ji,jl ) = 0._wp 970 pa_i (ji,jl ) = 0._wp 971 pa_i (ji,1:jl-1) = pa_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * phti(ji), epsi10 ) 910 972 END IF 911 973 END DO … … 915 977 ! 916 978 ! Compatibility tests 917 zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) )979 zconv = ABS( pati(ji) - SUM( pa_i(ji,1:jpl) ) ) 918 980 IF ( zconv < epsi06 ) itest(1) = 1 ! Test 1: area conservation 919 981 ! 920 zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) )982 zconv = ABS( phti(ji)*pati(ji) - SUM( pa_i(ji,1:jpl)*ph_i(ji,1:jpl) ) ) 921 983 IF ( zconv < epsi06 ) itest(2) = 1 ! Test 2: volume conservation 922 984 ! 923 IF ( zh_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1! Test 3: thickness of the last category is in-bounds ?985 IF ( ph_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 ! Test 3: thickness of the last category is in-bounds ? 924 986 ! 925 987 itest(4) = 1 926 988 DO jl = 1, i_fill 927 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0! Test 4: positivity of ice concentrations989 IF ( pa_i(ji,jl) < 0._wp ) itest(4) = 0 ! Test 4: positivity of ice concentrations 928 990 END DO 929 991 ! !---------------------------- … … 933 995 END DO 934 996 935 ! Add Snow in each category where za_i is not 0997 ! Add Snow in each category where pa_i is not 0 936 998 DO jl = 1, jpl 937 999 DO ji = 1, idim 938 IF( za_i(ji,jl) > 0._wp ) THEN939 zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) )1000 IF( pa_i(ji,jl) > 0._wp ) THEN 1001 ph_s(ji,jl) = ph_i(ji,jl) * ( phts(ji) / phti(ji) ) 940 1002 ! In case snow load is in excess that would lead to transformation from snow to ice 941 1003 ! Then, transfer the snow excess into the ice (different from icethd_dh) 942 zdh = MAX( 0._wp, ( rhos * zh_s(ji,jl) + ( rhoi - rau0 ) * zh_i(ji,jl) ) * r1_rau0 )1004 zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 ) 943 1005 ! recompute h_i, h_s avoiding out of bounds values 944 zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh )945 zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos )1006 ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 1007 ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 946 1008 ENDIF 947 1009 END DO 948 1010 END DO 949 1011 ! 1012 ! == temperature and salinity == ! 1013 DO jl = 1, jpl 1014 pt_i (:,jl) = ptmi (:) 1015 pt_s (:,jl) = ptms (:) 1016 pt_su(:,jl) = ptmsu(:) 1017 ps_i (:,jl) = psmi (:) 1018 ps_i (:,jl) = psmi (:) 1019 END DO 1020 ! 1021 ! == ponds == ! 1022 ALLOCATE( zfra(idim) ) 1023 ! keep the same pond fraction atip/ati for each category 1024 WHERE( pati(:) /= 0._wp ) ; zfra(:) = patip(:) / pati(:) 1025 ELSEWHERE ; zfra(:) = 0._wp 1026 END WHERE 1027 DO jl = 1, jpl 1028 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1029 END DO 1030 ! keep the same v_ip/v_i ratio for each category 1031 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 1032 ELSEWHERE ; zfra(:) = 0._wp 1033 END WHERE 1034 DO jl = 1, jpl 1035 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1036 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1037 END WHERE 1038 END DO 1039 DEALLOCATE( zfra ) 1040 ! 950 1041 END SUBROUTINE ice_var_itd_1cMc 951 1042 952 SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 1043 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1044 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 953 1045 !!------------------------------------------------------------------- 954 1046 !! … … 971 1063 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 972 1064 !! 973 !! ** Arguments : zhti: N-cat ice thickness974 !! zhts: N-cat snow depth975 !! zati: N-cat ice concentration1065 !! ** Arguments : phti: N-cat ice thickness 1066 !! phts: N-cat snow depth 1067 !! pati: N-cat ice concentration 976 1068 !! 977 1069 !! ** Output : jpl-cat … … 979 1071 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 980 1072 !!------------------------------------------------------------------- 981 INTEGER :: ji, jl, jl1, jl2 ! dummy loop indices 1073 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1074 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1075 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 1076 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 1077 ! 1078 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 1079 INTEGER , ALLOCATABLE, DIMENSION(:) :: jlmax, jlmin 1080 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp, zfra 1081 ! 1082 REAL(wp), PARAMETER :: ztrans = 0.25_wp 1083 INTEGER :: ji, jl, jl1, jl2 982 1084 INTEGER :: idim, icat 983 REAL(wp), PARAMETER :: ztrans = 0.25_wp 984 REAL(wp), DIMENSION(:,:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables 985 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables 986 INTEGER , DIMENSION(:,:), ALLOCATABLE :: jlfil, jlfil2 987 INTEGER , DIMENSION(:) , ALLOCATABLE :: jlmax, jlmin 988 !!------------------------------------------------------------------- 989 ! 990 idim = SIZE( zhti, 1 ) 991 icat = SIZE( zhti, 2 ) 1085 !!------------------------------------------------------------------- 1086 ! 1087 idim = SIZE( phti, 1 ) 1088 icat = SIZE( phti, 2 ) 1089 ! 1090 ! == thickness and concentration == ! 992 1091 ! ! ---------------------- ! 993 1092 IF( icat == jpl ) THEN ! input cat = output cat ! 994 1093 ! ! ---------------------- ! 995 zh_i(:,:) = zhti(:,:) 996 zh_s(:,:) = zhts(:,:) 997 za_i(:,:) = zati(:,:) 1094 ph_i(:,:) = phti(:,:) 1095 ph_s(:,:) = phts(:,:) 1096 pa_i(:,:) = pati(:,:) 1097 ! 1098 ! == temperature and salinity and ponds == ! 1099 pt_i (:,:) = ptmi (:,:) 1100 pt_s (:,:) = ptms (:,:) 1101 pt_su(:,:) = ptmsu(:,:) 1102 ps_i (:,:) = psmi (:,:) 1103 pa_ip(:,:) = patip(:,:) 1104 ph_ip(:,:) = phtip(:,:) 998 1105 ! ! ---------------------- ! 999 1106 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1000 1107 ! ! ---------------------- ! 1001 CALL ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i(:,:), zh_s(:,:), za_i(:,:) ) 1108 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1109 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1110 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 1111 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) ) 1002 1112 ! ! ---------------------- ! 1003 1113 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1004 1114 ! ! ---------------------- ! 1005 CALL ice_var_itd_Nc1c( zhti(:,:), zhts(:,:), zati(:,:), zh_i(:,1), zh_s(:,1), za_i(:,1) ) 1115 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1116 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1117 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 1118 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) ) 1006 1119 ! ! ----------------------- ! 1007 1120 ELSE ! input cat /= output cat ! … … 1012 1125 1013 1126 ! --- initialize output fields to 0 --- ! 1014 zh_i(1:idim,1:jpl) = 0._wp1015 zh_s(1:idim,1:jpl) = 0._wp1016 za_i(1:idim,1:jpl) = 0._wp1127 ph_i(1:idim,1:jpl) = 0._wp 1128 ph_s(1:idim,1:jpl) = 0._wp 1129 pa_i(1:idim,1:jpl) = 0._wp 1017 1130 ! 1018 1131 ! --- fill the categories --- ! … … 1024 1137 DO jl2 = 1, icat 1025 1138 DO ji = 1, idim 1026 IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN1139 IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 1027 1140 ! fill the right category 1028 zh_i(ji,jl1) = zhti(ji,jl2)1029 zh_s(ji,jl1) = zhts(ji,jl2)1030 za_i(ji,jl1) = zati(ji,jl2)1141 ph_i(ji,jl1) = phti(ji,jl2) 1142 ph_s(ji,jl1) = phts(ji,jl2) 1143 pa_i(ji,jl1) = pati(ji,jl2) 1031 1144 ! record categories that are filled 1032 1145 jlmax(ji) = MAX( jlmax(ji), jl1 ) … … 1045 1158 IF( jl1 > 1 ) THEN 1046 1159 ! fill the lower cat (jl1-1) 1047 za_i(ji,jl1-1) = ztrans * za_i(ji,jl1)1048 zh_i(ji,jl1-1) = hi_mean(jl1-1)1160 pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 1161 ph_i(ji,jl1-1) = hi_mean(jl1-1) 1049 1162 ! remove from cat jl1 1050 za_i(ji,jl1 ) = ( 1._wp - ztrans ) * za_i(ji,jl1)1163 pa_i(ji,jl1 ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 1051 1164 ENDIF 1052 1165 IF( jl2 < jpl ) THEN 1053 1166 ! fill the upper cat (jl2+1) 1054 za_i(ji,jl2+1) = ztrans * za_i(ji,jl2)1055 zh_i(ji,jl2+1) = hi_mean(jl2+1)1167 pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 1168 ph_i(ji,jl2+1) = hi_mean(jl2+1) 1056 1169 ! remove from cat jl2 1057 za_i(ji,jl2 ) = ( 1._wp - ztrans ) * za_i(ji,jl2)1170 pa_i(ji,jl2 ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 1058 1171 ENDIF 1059 1172 END DO … … 1065 1178 IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 1066 1179 ! fill high 1067 za_i(ji,jl) = ztrans * za_i(ji,jl-1)1068 zh_i(ji,jl) = hi_mean(jl)1180 pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 1181 ph_i(ji,jl) = hi_mean(jl) 1069 1182 jlfil(ji,jl) = jl 1070 1183 ! remove low 1071 za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1)1184 pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 1072 1185 ENDIF 1073 1186 END DO … … 1079 1192 IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 1080 1193 ! fill low 1081 za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1)1082 zh_i(ji,jl) = hi_mean(jl)1194 pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 1195 ph_i(ji,jl) = hi_mean(jl) 1083 1196 jlfil2(ji,jl) = jl 1084 1197 ! remove high 1085 za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1)1198 pa_i(ji,jl+1) = ( 1._wp - ztrans ) * pa_i(ji,jl+1) 1086 1199 ENDIF 1087 1200 END DO … … 1090 1203 DEALLOCATE( jlfil, jlfil2 ) ! deallocate arrays 1091 1204 DEALLOCATE( jlmin, jlmax ) 1205 ! 1206 ! == temperature and salinity == ! 1207 ! 1208 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1209 ! 1210 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1211 ELSEWHERE ; z1_ai(:) = 0._wp 1212 END WHERE 1213 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1214 ELSEWHERE ; z1_vi(:) = 0._wp 1215 END WHERE 1216 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1217 ELSEWHERE ; z1_vs(:) = 0._wp 1218 END WHERE 1219 ! 1220 ! fill all the categories with the same value 1221 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1222 DO jl = 1, jpl 1223 pt_i (:,jl) = ztmp(:) 1224 END DO 1225 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1226 DO jl = 1, jpl 1227 pt_s (:,jl) = ztmp(:) 1228 END DO 1229 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1230 DO jl = 1, jpl 1231 pt_su(:,jl) = ztmp(:) 1232 END DO 1233 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1234 DO jl = 1, jpl 1235 ps_i (:,jl) = ztmp(:) 1236 END DO 1237 ! 1238 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1239 ! 1240 ! == ponds == ! 1241 ALLOCATE( zfra(idim) ) 1242 ! keep the same pond fraction atip/ati for each category 1243 WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp ) ; zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 1244 ELSEWHERE ; zfra(:) = 0._wp 1245 END WHERE 1246 DO jl = 1, jpl 1247 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1248 END DO 1249 ! keep the same v_ip/v_i ratio for each category 1250 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1251 zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1252 ELSEWHERE 1253 zfra(:) = 0._wp 1254 END WHERE 1255 DO jl = 1, jpl 1256 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1257 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1258 END WHERE 1259 END DO 1260 DEALLOCATE( zfra ) 1092 1261 ! 1093 1262 ENDIF -
NEMO/trunk/src/ICE/icewri.F90
r10911 r11536 50 50 INTEGER :: ji, jj, jk, jl ! dummy loop indices 51 51 REAL(wp) :: z2da, z2db, zrho1, zrho2 52 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zfast ! 2D workspace 52 REAL(wp) :: zmiss_val ! missing value retrieved from xios 53 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zfast ! 2D workspace 53 54 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 54 55 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zmsk00l, zmsksnl ! cat masks … … 58 59 REAL(wp) :: zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 59 60 !!------------------------------------------------------------------- 60 61 ! 61 62 IF( ln_timing ) CALL timing_start('icewri') 63 64 ! get missing value from xml 65 CALL iom_miss_val( 'icetemp', zmiss_val ) 62 66 63 67 ! brine volume … … 85 89 ! Standard outputs 86 90 !----------------- 87 zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau091 zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0 88 92 ! masks 89 IF( iom_use('icemask' ) ) CALL iom_put( "icemask" , zmsk00 ) ! ice mask 0% 90 IF( iom_use('icemask05') ) CALL iom_put( "icemask05", zmsk05 ) ! ice mask 5% 91 IF( iom_use('icemask15') ) CALL iom_put( "icemask15", zmsk15 ) ! ice mask 15% 93 CALL iom_put( 'icemask' , zmsk00 ) ! ice mask 0% 94 CALL iom_put( 'icemask05', zmsk05 ) ! ice mask 5% 95 CALL iom_put( 'icemask15', zmsk15 ) ! ice mask 15% 96 CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) 92 97 ! 93 98 ! general fields 94 IF( iom_use('icemass' ) ) CALL iom_put( "icemass", rhoi * vt_i * zmsk00 ) ! Ice mass per cell area 95 IF( iom_use('snwmass' ) ) CALL iom_put( "snwmass", rhos * vt_s * zmsksn ) ! Snow mass per cell area 96 IF( iom_use('icepres' ) ) CALL iom_put( "icepres", zmsk00 ) ! Ice presence (1 or 0) 97 IF( iom_use('iceconc' ) ) CALL iom_put( "iceconc", at_i * zmsk00 ) ! ice concentration 98 IF( iom_use('icevolu' ) ) CALL iom_put( "icevolu", vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell 99 IF( iom_use('icethic' ) ) CALL iom_put( "icethic", hm_i * zmsk00 ) ! ice thickness 100 IF( iom_use('snwthic' ) ) CALL iom_put( "snwthic", hm_s * zmsk00 ) ! snw thickness 101 IF( iom_use('icebrv' ) ) CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. ) ! brine volume 102 IF( iom_use('iceage' ) ) CALL iom_put( "iceage" , om_i * zmsk15 / rday ) ! ice age 103 IF( iom_use('icehnew' ) ) CALL iom_put( "icehnew", ht_i_new ) ! new ice thickness formed in the leads 104 IF( iom_use('snwvolu' ) ) CALL iom_put( "snwvolu", vt_s * zmsksn ) ! snow volume 105 IF( iom_use('icefrb') ) THEN 99 IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area 100 IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s * rhos * zmsksn ) ! Snow mass per cell area 101 IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i * zmsk00 ) ! ice concentration 102 IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell 103 IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i * zmsk00 ) ! ice thickness 104 IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s * zmsk00 ) ! snw thickness 105 IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 ) ! brine volume 106 IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age 107 IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new ) ! new ice thickness formed in the leads 108 IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s * zmsksn ) ! snow volume 109 IF( iom_use('icefrb' ) ) THEN ! Ice freeboard 106 110 z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 107 111 WHERE( z2d < 0._wp ) z2d = 0._wp 108 CALL iom_put( "icefrb" , z2d * zmsk00 ) ! Ice freeboard112 CALL iom_put( 'icefrb' , z2d * zmsk00 ) 109 113 ENDIF 110 !111 114 ! melt ponds 112 IF( iom_use('iceapnd' ) ) CALL iom_put( "iceapnd", at_ip * zmsk00 )! melt pond total fraction113 IF( iom_use('ice vpnd' ) ) CALL iom_put( "icevpnd", vt_ip * zmsk00 ) ! melt pond total volume per unit area114 !115 IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip * zmsk00 ) ! melt pond total fraction 116 IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip * zmsk00 ) ! melt pond depth 117 IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area 115 118 ! salt 116 IF( iom_use('icesalt' ) ) CALL iom_put( "icesalt", sm_i * zmsk00 ) ! mean ice salinity 117 IF( iom_use('icesalm' ) ) CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area 118 119 IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 120 IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area 119 121 ! heat 120 IF( iom_use('icetemp' ) ) CALL iom_put( "icetemp", ( tm_i - rt0 ) * zmsk00 ) ! ice mean temperature 121 IF( iom_use('snwtemp' ) ) CALL iom_put( "snwtemp", ( tm_s - rt0 ) * zmsksn ) ! snw mean temperature 122 IF( iom_use('icettop' ) ) CALL iom_put( "icettop", ( tm_su - rt0 ) * zmsk00 ) ! temperature at the ice surface 123 IF( iom_use('icetbot' ) ) CALL iom_put( "icetbot", ( t_bo - rt0 ) * zmsk00 ) ! temperature at the ice bottom 124 IF( iom_use('icetsni' ) ) CALL iom_put( "icetsni", ( tm_si - rt0 ) * zmsk00 ) ! temperature at the snow-ice interface 125 IF( iom_use('icehc' ) ) CALL iom_put( "icehc" , -et_i * zmsk00 ) ! ice heat content 126 IF( iom_use('snwhc' ) ) CALL iom_put( "snwhc" , -et_s * zmsksn ) ! snow heat content 127 122 IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature 123 IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature 124 IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface 125 IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom 126 IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface 127 IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i * zmsk00 ) ! ice heat content 128 IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s * zmsksn ) ! snow heat content 128 129 ! momentum 129 IF( iom_use('uice' ) ) CALL iom_put( "uice" , u_ice ) ! ice velocity u component 130 IF( iom_use('vice' ) ) CALL iom_put( "vice" , v_ice ) ! ice velocity v component 131 IF( iom_use('utau_ai' ) ) CALL iom_put( "utau_ai", utau_ice * zmsk00 ) ! Wind stress term in force balance (x) 132 IF( iom_use('vtau_ai' ) ) CALL iom_put( "vtau_ai", vtau_ice * zmsk00 ) ! Wind stress term in force balance (y) 133 134 IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN 135 ! module of ice velocity 130 IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice ) ! ice velocity u 131 IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice ) ! ice velocity v 132 ! 133 IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity 136 134 DO jj = 2 , jpjm1 137 135 DO ji = 2 , jpim1 138 z2da = ( u_ice(ji,jj) + u_ice(ji-1,jj))139 z2db = ( v_ice(ji,jj) + v_ice(ji,jj-1))136 z2da = u_ice(ji,jj) + u_ice(ji-1,jj) 137 z2db = v_ice(ji,jj) + v_ice(ji,jj-1) 140 138 z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 141 139 END DO 142 140 END DO 143 141 CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 144 IF( iom_use('icevel') ) CALL iom_put( "icevel" , z2d ) 145 146 ! record presence of fast ice 147 WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp 142 CALL iom_put( 'icevel', z2d ) 143 144 WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice 148 145 ELSEWHERE ; zfast(:,:) = 0._wp 149 146 END WHERE 150 IF( iom_use('fasticepres') ) CALL iom_put( "fasticepres", zfast )147 CALL iom_put( 'fasticepres', zfast ) 151 148 ENDIF 152 149 153 150 ! --- category-dependent fields --- ! 154 IF( iom_use('icemask_cat' ) ) CALL iom_put( "icemask_cat" , zmsk00l ) ! ice mask 0% 155 IF( iom_use('iceconc_cat' ) ) CALL iom_put( "iceconc_cat" , a_i * zmsk00l ) ! area for categories 156 IF( iom_use('icethic_cat' ) ) CALL iom_put( "icethic_cat" , h_i * zmsk00l ) ! thickness for categories 157 IF( iom_use('snwthic_cat' ) ) CALL iom_put( "snwthic_cat" , h_s * zmsksnl ) ! snow depth for categories 158 IF( iom_use('icesalt_cat' ) ) CALL iom_put( "icesalt_cat" , s_i * zmsk00l ) ! salinity for categories 159 IF( iom_use('iceage_cat' ) ) CALL iom_put( "iceage_cat" , o_i * zmsk00l / rday ) ! ice age 160 IF( iom_use('icetemp_cat' ) ) CALL iom_put( "icetemp_cat" , ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zmsk00l ) ! ice temperature 161 IF( iom_use('snwtemp_cat' ) ) CALL iom_put( "snwtemp_cat" , ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zmsksnl ) ! snow temperature 162 IF( iom_use('icettop_cat' ) ) CALL iom_put( "icettop_cat" , ( t_su - rt0 ) * zmsk00l ) ! surface temperature 163 IF( iom_use('icebrv_cat' ) ) CALL iom_put( "icebrv_cat" , bv_i * 100. * zmsk00l ) ! brine volume 164 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( "iceapnd_cat" , a_ip * zmsk00l ) ! melt pond frac for categories 165 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( "icehpnd_cat" , h_ip * zmsk00l ) ! melt pond frac for categories 166 IF( iom_use('iceafpnd_cat') ) CALL iom_put( "iceafpnd_cat", a_ip_frac * zmsk00l ) ! melt pond frac for categories 151 IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0% 152 IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i * zmsk00l ) ! area for categories 153 IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories 154 IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories 155 IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories 156 IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i / rday * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age 157 IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) & 158 & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature 159 IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) & 160 & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature 161 IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature 162 IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 163 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories 164 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 165 IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac for categories 167 166 168 167 !------------------ … … 170 169 !------------------ 171 170 ! trends 172 IF( iom_use('dmithd') ) CALL iom_put( "dmithd", - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics173 IF( iom_use('dmidyn') ) CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi )! Sea-ice mass change from dynamics(kg/m2/s)174 IF( iom_use('dmiopw') ) CALL iom_put( "dmiopw", - wfx_opw )! Sea-ice mass change through growth in open water175 IF( iom_use('dmibog') ) CALL iom_put( "dmibog", - wfx_bog )! Sea-ice mass change through basal growth176 IF( iom_use('dmisni') ) CALL iom_put( "dmisni", - wfx_sni )! Sea-ice mass change through snow-to-ice conversion177 IF( iom_use('dmisum') ) CALL iom_put( "dmisum", - wfx_sum )! Sea-ice mass change through surface melting178 IF( iom_use('dmibom') ) CALL iom_put( "dmibom", - wfx_bom )! Sea-ice mass change through bottom melting179 IF( iom_use('dmtsub') ) CALL iom_put( "dmtsub", - wfx_sub )! Sea-ice mass change through evaporation and sublimation180 IF( iom_use('dmssub') ) CALL iom_put( "dmssub", - wfx_snw_sub )! Snow mass change through sublimation181 IF( iom_use('dmisub') ) CALL iom_put( "dmisub", - wfx_ice_sub )! Sea-ice mass change through sublimation182 IF( iom_use('dmsspr') ) CALL iom_put( "dmsspr", - wfx_spr )! Snow mass change through snow fall183 IF( iom_use('dmsssi') ) CALL iom_put( "dmsssi", wfx_sni*rhos*r1_rhoi )! Snow mass change through snow-to-ice conversion184 IF( iom_use('dmsmel') ) CALL iom_put( "dmsmel", - wfx_snw_sum )! Snow mass change through melt185 IF( iom_use('dmsdyn') ) CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs )! Snow mass change through dynamics(kg/m2/s)186 171 IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics 172 IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s) 173 IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water 174 IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth 175 IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion 176 IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting 177 IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting 178 IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation 179 IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation 180 IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation 181 IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall 182 IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion 183 IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt 184 IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) 185 187 186 ! Global ice diagnostics 188 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') ) THEN ! NH diagnostics 189 ! 190 WHERE( ff_t > 0._wp ) ; zmsk00(:,:) = 1.0e-12 191 ELSEWHERE ; zmsk00(:,:) = 0. 192 END WHERE 193 zdiag_area_nh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 194 zdiag_volu_nh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 195 ! 196 WHERE( ff_t > 0._wp .AND. at_i > 0.15 ) ; zmsk00(:,:) = 1.0e-12 197 ELSEWHERE ; zmsk00(:,:) = 0. 198 END WHERE 199 zdiag_extt_nh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) ) 200 ! 201 IF( iom_use('NH_icearea') ) CALL iom_put( "NH_icearea" , zdiag_area_nh ) 202 IF( iom_use('NH_icevolu') ) CALL iom_put( "NH_icevolu" , zdiag_volu_nh ) 203 IF( iom_use('NH_iceextt') ) CALL iom_put( "NH_iceextt" , zdiag_extt_nh ) 187 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & 188 & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN 189 ! 190 WHERE( ff_t(:,:) > 0._wp ) ; z2d(:,:) = 1._wp 191 ELSEWHERE ; z2d(:,:) = 0. 192 END WHERE 193 ! 194 IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i * z2d * e1e2t * 1.e-12 ) 195 IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i * z2d * e1e2t * 1.e-12 ) 196 IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t * 1.e-12 * zmsk15 ) 197 ! 198 IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 199 IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 200 IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 ) 201 ! 202 CALL iom_put( 'NH_icearea' , zdiag_area_nh ) 203 CALL iom_put( 'NH_icevolu' , zdiag_volu_nh ) 204 CALL iom_put( 'NH_iceextt' , zdiag_extt_nh ) 205 CALL iom_put( 'SH_icearea' , zdiag_area_sh ) 206 CALL iom_put( 'SH_icevolu' , zdiag_volu_sh ) 207 CALL iom_put( 'SH_iceextt' , zdiag_extt_sh ) 204 208 ! 205 209 ENDIF 206 !207 IF( iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN ! SH diagnostics208 !209 WHERE( ff_t < 0._wp ); zmsk00(:,:) = 1.0e-12;210 ELSEWHERE ; zmsk00(:,:) = 0.211 END WHERE212 zdiag_area_sh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )213 zdiag_volu_sh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )214 !215 WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zmsk00(:,:) = 1.0e-12216 ELSEWHERE ; zmsk00(:,:) = 0.217 END WHERE218 zdiag_extt_sh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) )219 !220 IF( iom_use('SH_icearea') ) CALL iom_put( "SH_icearea", zdiag_area_sh )221 IF( iom_use('SH_icevolu') ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )222 IF( iom_use('SH_iceextt') ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )223 !224 ENDIF225 210 ! 226 211 !!CR ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 227 212 !!CR ! IF( kindic < 0 ) CALL ice_wri_state( 'output.abort' ) 228 213 !!CR ! not yet implemented 229 !!gm idem for the ocean... Ask Seb how to get r ead of ioipsl....214 !!gm idem for the ocean... Ask Seb how to get rid of ioipsl.... 230 215 ! 231 216 IF( ln_timing ) CALL timing_stop('icewri')
Note: See TracChangeset
for help on using the changeset viewer.