Changeset 12143 for NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE
- Timestamp:
- 2019-12-10T12:57:49+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE
- Files:
-
- 26 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/ice.F90
r10882 r12143 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 … … 328 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS] 329 329 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond fraction per grid cell area330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration 331 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond volume per ice area 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond thickness [m] 334 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond fraction (a_ip/a_i) 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond depth [m] 334 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond concentration 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per gridcell area [m] 337 338 338 339 !!---------------------------------------------------------------------- … … 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icealb.F90
r10535 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icecor.F90
r10994 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icectl.F90
r10994 r12143 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 rates 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 = 2.5e-7 ! kg/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost 49 REAL(wp), PARAMETER :: zchk_s = 2.5e-6 ! g/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg) 50 REAL(wp), PARAMETER :: zchk_t = 7.5e-2 ! W/m2 <=> 1e-6 m of ice per hour 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 (zv_sill, zs_sill, zt_sill) which determine violations are set to 62 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 70 !! The thresholds (zchk_m, zchk_s, zchk_t) determine violations 63 71 !! For salt and heat thresholds, ice is considered to have a salinity of 10 64 72 !! and a heat content of 3e5 J/kg (=latent heat of fusion) … … 68 76 REAL(wp) , INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 69 77 !! 70 REAL(wp) :: z v, zs, zt, zfs, zfv, zft71 REAL(wp) :: zvmin, zamin, zamax, zeimin, zesmin, zsmin78 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat, & 79 & zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 72 80 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 81 REAL(wp) :: zarea 75 82 !!------------------------------------------------------------------- 76 83 ! 77 84 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 85 86 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 87 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) 88 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 89 90 ! mass flux 91 pdiag_fv = glob_sum( 'icectl', & 92 & ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 93 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 94 ! salt flux 95 pdiag_fs = glob_sum( 'icectl', & 96 & ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 97 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 98 ! heat flux 99 pdiag_ft = glob_sum( 'icectl', & 100 & ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 101 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 102 103 ELSEIF( icount == 1 ) THEN 104 105 ! -- mass diag -- ! 106 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice & 107 & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & 108 & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 109 & wfx_ice_sub + wfx_spr ) * e1e2t ) & 110 & - pdiag_fv 85 111 ! 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(:,:) ) * zconv112 ! -- salt diag -- ! 113 zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice & 114 & + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 115 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 116 & - pdiag_fs 91 117 ! 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 118 ! -- heat diag -- ! 119 zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 120 & ) * r1_rdtice & 121 & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 122 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & 123 & - pdiag_ft 124 125 ! -- min/max diag -- ! 126 zdiag_amax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 127 zdiag_vmin = glob_min( 'icectl', v_i ) 128 zdiag_amin = glob_min( 'icectl', a_i ) 129 zdiag_smin = glob_min( 'icectl', sv_i ) 130 zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 131 zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 132 133 ! -- advection scheme is conservative? -- ! 134 zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather) 135 zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) ! must be close to 0 (only for Prather) 136 137 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 138 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 139 140 IF( lwp ) THEN 157 141 ! 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 142 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 143 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 144 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 145 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 146 IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 147 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 148 ! check negative values 149 IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin 150 IF( zdiag_amin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_amin 151 IF( zdiag_smin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_smin 152 IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin 153 IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin 161 154 ! 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 155 IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 156 & WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_amax 157 ! check if advection scheme is conservative 158 ! only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc) 159 ! so the formulation for conservation is different (and not coded) 160 ! it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 161 !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 162 ! & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 175 163 ENDIF 176 164 ! … … 179 167 END SUBROUTINE ice_cons_hsm 180 168 181 182 169 SUBROUTINE ice_cons_final( cd_routine ) 183 170 !!------------------------------------------------------------------- … … 188 175 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 189 176 !! It prints in ocean.output if there is a violation of conservation at each time-step 190 !! The thresholds (zv_sill, zs_sill, zt_sill) which determine the violation are set to 191 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 177 !! The thresholds (zchk_m, zchk_s, zchk_t) determine the violations 192 178 !! For salt and heat thresholds, ice is considered to have a salinity of 10 193 179 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 194 180 !!------------------------------------------------------------------- 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 181 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 182 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat 183 REAL(wp) :: zarea 199 184 !!------------------------------------------------------------------- 200 185 201 186 ! 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 187 ! -- mass diag -- ! 188 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 189 190 ! -- salt diag -- ! 191 zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 192 193 ! -- heat diag -- ! 208 194 ! 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 195 !!zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr & 196 !! & ) * e1e2t ) 197 198 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 199 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 200 201 IF( lwp ) THEN 202 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 203 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 204 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 205 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 206 !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 222 207 ENDIF 223 208 ! 224 209 END SUBROUTINE ice_cons_final 225 210 211 SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft ) 212 !!------------------------------------------------------------------- 213 !! *** ROUTINE ice_cons2D *** 214 !! 215 !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 216 !! + test if ice concentration and volume are > 0 217 !! 218 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 219 !! It stops the code if there is a violation of conservation at any gridcell 220 !!------------------------------------------------------------------- 221 INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end 222 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 223 REAL(wp) , DIMENSION(jpi,jpj), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 224 !! 225 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, & 226 & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 227 INTEGER :: jl, jk 228 LOGICAL :: ll_stop_m = .FALSE. 229 LOGICAL :: ll_stop_s = .FALSE. 230 LOGICAL :: ll_stop_t = .FALSE. 231 CHARACTER(len=120) :: clnam ! filename for the output 232 !!------------------------------------------------------------------- 233 ! 234 IF( icount == 0 ) THEN 235 236 pdiag_v = SUM( v_i * rhoi + v_s * rhos, dim=3 ) 237 pdiag_s = SUM( sv_i * rhoi , dim=3 ) 238 pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 239 240 ! mass flux 241 pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 242 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 243 ! salt flux 244 pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 245 ! heat flux 246 pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 247 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 248 249 ELSEIF( icount == 1 ) THEN 250 251 ! -- mass diag -- ! 252 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice & 253 & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 254 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) & 255 & - pdiag_fv 256 IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel ) ll_stop_m = .TRUE. 257 ! 258 ! -- salt diag -- ! 259 zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice & 260 & + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 261 & - pdiag_fs 262 IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel ) ll_stop_s = .TRUE. 263 ! 264 ! -- heat diag -- ! 265 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice & 266 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 267 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) & 268 & - pdiag_ft 269 IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel ) ll_stop_t = .TRUE. 270 ! 271 ! -- other diags -- ! 272 ! a_i < 0 273 zdiag_amin(:,:) = 0._wp 274 DO jl = 1, jpl 275 WHERE( a_i(:,:,jl) < 0._wp ) zdiag_amin(:,:) = 1._wp 276 ENDDO 277 ! v_i < 0 278 zdiag_vmin(:,:) = 0._wp 279 DO jl = 1, jpl 280 WHERE( v_i(:,:,jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp 281 ENDDO 282 ! s_i < 0 283 zdiag_smin(:,:) = 0._wp 284 DO jl = 1, jpl 285 WHERE( s_i(:,:,jl) < 0._wp ) zdiag_smin(:,:) = 1._wp 286 ENDDO 287 ! e_i < 0 288 zdiag_emin(:,:) = 0._wp 289 DO jl = 1, jpl 290 DO jk = 1, nlay_i 291 WHERE( e_i(:,:,jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp 292 ENDDO 293 ENDDO 294 ! a_i > amax 295 !WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 ) ; zdiag_amax(:,:) = 1._wp 296 !ELSEWHERE ; zdiag_amax(:,:) = 0._wp 297 !END WHERE 298 299 IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN 300 clnam = 'diag_ice_conservation_'//cd_routine 301 CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin ) 302 ENDIF 303 304 IF( ll_stop_m ) CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' ) 305 IF( ll_stop_s ) CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 306 IF( ll_stop_t ) CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 307 308 ENDIF 309 310 END SUBROUTINE ice_cons2D 311 312 SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin ) 313 !!--------------------------------------------------------------------- 314 !! *** ROUTINE ice_cons_wri *** 315 !! 316 !! ** Purpose : create a NetCDF file named cdfile_name which contains 317 !! the instantaneous fields when conservation issue occurs 318 !! 319 !! ** Method : NetCDF files using ioipsl 320 !!---------------------------------------------------------------------- 321 CHARACTER(len=*), INTENT( in ) :: cdfile_name ! name of the file created 322 REAL(wp), DIMENSION(:,:), INTENT( in ) :: pdiag_mass, pdiag_salt, pdiag_heat, & 323 & pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 324 !! 325 INTEGER :: inum 326 !!---------------------------------------------------------------------- 327 ! 328 IF(lwp) WRITE(numout,*) 329 IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 330 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ named :', cdfile_name, '...nc' 331 IF(lwp) WRITE(numout,*) 332 333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 334 335 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain 336 CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 ) ! ice salt spurious lost/gain 337 CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 ) ! ice heat spurious lost/gain 338 ! other diags 339 CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) ! 340 CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) ! 341 CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) ! 342 CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) ! 343 344 CALL iom_close( inum ) 345 346 END SUBROUTINE ice_cons_wri 226 347 227 348 SUBROUTINE ice_ctl( kt ) … … 246 367 ialert_id = 2 ! reference number of this alert 247 368 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 248 249 369 DO jl = 1, jpl 250 370 DO jj = 1, jpj 251 371 DO ji = 1, jpi 252 372 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) 373 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 258 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 259 375 ENDIF … … 269 385 DO ji = 1, jpi 270 386 IF( h_i(ji,jj,jl) > 50._wp ) THEN 387 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 271 388 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 272 389 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 280 397 DO jj = 1, jpj 281 398 DO ji = 1, jpi 282 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5.AND. &399 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 283 400 & at_i(ji,jj) > 0._wp ) THEN 401 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 284 402 !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,*) 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 404 ENDIF 405 END DO 406 END DO 407 408 ! Alert on salt flux 409 ialert_id = 5 ! reference number of this alert 410 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 414 WRITE(numout,*) ' ALERTE 5 : High salt flux' 415 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 293 416 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 294 417 ENDIF … … 302 425 DO ji = 1, jpi 303 426 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 427 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 304 428 !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 429 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 315 430 ENDIF … … 325 440 DO ji = 1, jpi 326 441 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 442 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 327 443 ! 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 444 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 332 445 ENDIF … … 335 448 END DO 336 449 ! 450 ! Alert if qns very big 451 ialert_id = 8 ! reference number of this alert 452 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 453 DO jj = 1, jpj 454 DO ji = 1, jpi 455 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 456 ! 457 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 458 !CALL ice_prt( kt, ji, jj, 2, ' ') 459 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 460 ! 461 ENDIF 462 END DO 463 END DO 464 !+++++ 337 465 338 466 ! ! Alert if too old ice … … 345 473 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 346 474 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 475 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 347 476 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 348 477 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 351 480 END DO 352 481 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 482 393 483 ! Alert if very warm ice 394 484 ialert_id = 10 ! reference number of this alert … … 400 490 DO ji = 1, jpi 401 491 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 492 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 493 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 494 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 495 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 411 496 ENDIF 412 497 END DO … … 435 520 END SUBROUTINE ice_ctl 436 521 437 438 522 SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 439 523 !!------------------------------------------------------------------- … … 443 527 !! in ocean.ouput 444 528 !! 3 possibilities exist 445 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1)529 !! n = 1/-1 -> simple ice state 446 530 !! n = 2 -> exhaustive state 447 531 !! n = 3 -> ice/ocean salt fluxes … … 482 566 WRITE(numout,*) ' - Cell values ' 483 567 WRITE(numout,*) ' ~~~~~~~~~~~ ' 484 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)485 568 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 569 WRITE(numout,*) ' ato_i : ', ato_i(ji,jj) 486 570 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 487 571 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) … … 503 587 END DO 504 588 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 589 515 590 !-------------------- … … 525 600 WRITE(numout,*) ' - Cell values ' 526 601 WRITE(numout,*) ' ~~~~~~~~~~~ ' 527 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)528 602 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 529 603 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) … … 624 698 !! 625 699 !!------------------------------------------------------------------- 626 CHARACTER(len=*), INTENT(in) ::cd_routine ! name of the routine627 INTEGER ::jk, jl ! dummy loop indices700 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 701 INTEGER :: jk, jl ! dummy loop indices 628 702 629 703 CALL prt_ctl_info(' ========== ') … … 684 758 685 759 END SUBROUTINE ice_prt3D 686 760 687 761 #else 688 762 !!---------------------------------------------------------------------- -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedia.F90
r10425 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn.F90
r10994 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_adv.F90
r10911 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_adv_pra.F90
r10425 r12143 16 16 !! adv_pra_rst : read/write Prather field in ice restart file, or initialized to zero 17 17 !!---------------------------------------------------------------------- 18 USE phycst ! physical constant 18 19 USE dom_oce ! ocean domain 19 20 USE ice ! sea-ice variables 20 21 USE sbc_oce , ONLY : nn_fsbc ! frequency of sea-ice call 22 USE icevar ! sea-ice: operations 21 23 ! 22 24 USE in_out_manager ! I/O manager … … 25 27 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 26 28 USE lbclnk ! lateral boundary conditions (or mpp links) 27 USE prtctl ! Print control28 29 29 30 IMPLICIT NONE … … 36 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice ! ice thickness 37 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn ! snow thickness 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya ! lead fraction39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya ! ice concentration 39 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal ! ice salinity 40 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw ! open water in sea ice42 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 ! snow layers heat content 43 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content … … 81 81 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 82 82 ! 83 INTEGER :: jk, jl, jt ! dummy loop indices 84 INTEGER :: initad ! number of sub-timestep for the advection 85 REAL(wp) :: zcfl , zusnit ! - - 86 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0opw 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0smi, z0oi 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ap , z0vp 90 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z0es 91 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z0ei 83 INTEGER :: ji,jj, jk, jl, jt ! dummy loop indices 84 INTEGER :: icycle ! number of sub-timestep for the advection 85 REAL(wp) :: zdt ! - - 86 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 87 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 88 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx 89 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea 90 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0smi, z0oi 91 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ap , z0vp 92 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: z0es 93 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei 92 94 !!---------------------------------------------------------------------- 93 95 ! 94 96 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 95 97 ! 96 ALLOCATE( zarea(jpi,jpj) , z0opw(jpi,jpj, 1 ) , z0ice(jpi,jpj,jpl) , z0snw(jpi,jpj,jpl) , & 97 & z0ai(jpi,jpj,jpl) , z0smi(jpi,jpj,jpl) , z0oi (jpi,jpj,jpl) , z0ap (jpi,jpj,jpl) , z0vp(jpi,jpj,jpl) , & 98 & z0es (jpi,jpj,nlay_s,jpl), z0ei(jpi,jpj,nlay_i,jpl) ) 99 ! 100 ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 101 zcfl = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 102 zcfl = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 103 CALL mpp_max( 'icedyn_adv_pra', zcfl ) 98 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! 99 ! Note: the advection split is applied at the next time-step in order to avoid blocking global comm. 100 ! this should not affect too much the stability 101 zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 102 zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 104 103 105 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 106 ELSE ; initad = 1 ; zusnit = 1.0_wp 104 ! non-blocking global communication send zcflnow and receive zcflprv 105 CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) 106 107 IF( zcflprv(1) > .5 ) THEN ; icycle = 2 108 ELSE ; icycle = 1 107 109 ENDIF 110 zdt = rdt_ice / REAL(icycle) 108 111 109 zarea(:,:) = e1e2t(:,:) 110 !------------------------- 111 ! transported fields 112 !------------------------- 113 z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:) ! Open water area 114 DO jl = 1, jpl 115 z0snw(:,:,jl) = pv_s (:,:, jl) * e1e2t(:,:) ! Snow volume 116 z0ice(:,:,jl) = pv_i (:,:, jl) * e1e2t(:,:) ! Ice volume 117 z0ai (:,:,jl) = pa_i (:,:, jl) * e1e2t(:,:) ! Ice area 118 z0smi(:,:,jl) = psv_i(:,:, jl) * e1e2t(:,:) ! Salt content 119 z0oi (:,:,jl) = poa_i(:,:, jl) * e1e2t(:,:) ! Age content 120 DO jk = 1, nlay_s 121 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 122 END DO 123 DO jk = 1, nlay_i 124 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 125 END DO 126 IF ( ln_pnd_H12 ) THEN 127 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 128 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 112 ! --- transport --- ! 113 zudy(:,:) = pu_ice(:,:) * e2u(:,:) 114 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 115 116 DO jt = 1, icycle 117 118 ! record at_i before advection (for open water) 119 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 120 121 ! --- transported fields --- ! 122 DO jl = 1, jpl 123 zarea(:,:,jl) = e1e2t(:,:) 124 z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:) ! Snow volume 125 z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:) ! Ice volume 126 z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:) ! Ice area 127 z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:) ! Salt content 128 z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:) ! Age content 129 DO jk = 1, nlay_s 130 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 131 END DO 132 DO jk = 1, nlay_i 133 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 134 END DO 135 IF ( ln_pnd_H12 ) THEN 136 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 137 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 138 ENDIF 139 END DO 140 ! 141 ! !--------------------------------------------! 142 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 143 ! !--------------------------------------------! 144 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 145 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 146 CALL adv_x( zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 147 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 148 CALL adv_x( zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 149 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 150 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 151 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 152 CALL adv_x( zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 153 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 154 ! 155 DO jk = 1, nlay_s !--- snow heat content 156 CALL adv_x( zdt, zudy, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 157 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 158 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 159 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 160 END DO 161 DO jk = 1, nlay_i !--- ice heat content 162 CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 163 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 164 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 165 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 166 END DO 167 ! 168 IF ( ln_pnd_H12 ) THEN 169 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 170 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 171 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 172 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 173 ENDIF 174 ! !--------------------------------------------! 175 ELSE !== even ice time step: adv_y then adv_x ==! 176 ! !--------------------------------------------! 177 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 178 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 179 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 180 CALL adv_x( zdt , zudy , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 181 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 182 CALL adv_x( zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 183 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 184 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 185 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 186 CALL adv_x( zdt , zudy , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 187 DO jk = 1, nlay_s !--- snow heat content 188 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 189 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 190 CALL adv_x( zdt, zudy, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 191 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 192 END DO 193 DO jk = 1, nlay_i !--- ice heat content 194 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 195 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 196 CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 197 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 198 END DO 199 IF ( ln_pnd_H12 ) THEN 200 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 201 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 202 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 203 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 204 ENDIF 205 ! 129 206 ENDIF 207 208 ! --- Recover the properties from their contents --- ! 209 DO jl = 1, jpl 210 pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 211 pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 212 psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 213 poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 214 pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 215 DO jk = 1, nlay_s 216 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 217 END DO 218 DO jk = 1, nlay_i 219 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 220 END DO 221 IF ( ln_pnd_H12 ) THEN 222 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 223 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 224 ENDIF 225 END DO 226 ! 227 ! derive open water from ice concentration 228 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 229 DO jj = 2, jpjm1 230 DO ji = fs_2, fs_jpim1 231 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 232 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 233 END DO 234 END DO 235 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. ) 236 ! 237 ! --- Ensure non-negative fields --- ! 238 ! Remove negative values (conservation is ensured) 239 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 240 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 241 ! 242 ! --- Ensure snow load is not too big --- ! 243 CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 244 ! 130 245 END DO 131 132 ! !--------------------------------------------!133 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==!134 ! !--------------------------------------------!135 DO jt = 1, initad136 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area137 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )138 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), &139 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )140 DO jl = 1, jpl141 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---142 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )143 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), &144 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )145 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---146 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )147 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), &148 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )149 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---150 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )151 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), &152 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )153 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---154 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )155 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), &156 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )157 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---158 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )159 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), &160 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )161 DO jk = 1, nlay_s !--- snow heat contents ---162 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &163 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )164 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &165 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )166 END DO167 DO jk = 1, nlay_i !--- ice heat contents ---168 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &169 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )170 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &171 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )172 END DO173 IF ( ln_pnd_H12 ) THEN174 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction --175 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )176 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), &177 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )178 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume --179 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )180 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), &181 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )182 ENDIF183 END DO184 END DO185 ! !--------------------------------------------!186 ELSE !== even ice time step: adv_y then adv_x ==!187 ! !--------------------------------------------!188 DO jt = 1, initad189 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area190 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )191 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), &192 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )193 DO jl = 1, jpl194 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---195 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )196 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), &197 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )198 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---199 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )200 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), &201 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )202 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---203 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )204 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), &205 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )206 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---207 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )208 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), &209 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )210 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---211 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )212 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), &213 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )214 DO jk = 1, nlay_s !--- snow heat contents ---215 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &216 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )217 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &218 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )219 END DO220 DO jk = 1, nlay_i !--- ice heat contents ---221 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &222 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )223 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &224 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )225 END DO226 IF ( ln_pnd_H12 ) THEN227 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction ---228 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )229 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), &230 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )231 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume ---232 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )233 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), &234 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )235 ENDIF236 END DO237 END DO238 ENDIF239 240 !-------------------------------------------241 ! Recover the properties from their contents242 !-------------------------------------------243 pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) * tmask(:,:,1)244 DO jl = 1, jpl245 pv_i (:,:, jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)246 pv_s (:,:, jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)247 psv_i(:,:, jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)248 poa_i(:,:, jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)249 pa_i (:,:, jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)250 DO jk = 1, nlay_s251 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)252 END DO253 DO jk = 1, nlay_i254 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)255 END DO256 IF ( ln_pnd_H12 ) THEN257 pa_ip (:,:,jl) = z0ap (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)258 pv_ip (:,:,jl) = z0vp (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)259 ENDIF260 END DO261 !262 DEALLOCATE( zarea , z0opw , z0ice, z0snw , z0ai , z0smi , z0oi , z0ap , z0vp , z0es, z0ei )263 246 ! 264 247 IF( lrst_ice ) CALL adv_pra_rst( 'WRITE', kt ) !* write Prather fields in the restart file … … 267 250 268 251 269 SUBROUTINE adv_x( pd f, put , pcrh, psm , ps0 , &252 SUBROUTINE adv_x( pdt, put , pcrh, psm , ps0 , & 270 253 & psx, psxx, psy , psyy, psxy ) 271 254 !!---------------------------------------------------------------------- … … 275 258 !! variable on x axis 276 259 !!---------------------------------------------------------------------- 277 REAL(wp) , INTENT(in ) :: pdf ! reduction factor forthe time step278 REAL(wp) 279 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: put ! i-direction ice velocity at U-point [m/s]280 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psm ! area281 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: ps0 ! field to be advected282 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments283 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments260 REAL(wp) , INTENT(in ) :: pdt ! the time step 261 REAL(wp) , INTENT(in ) :: pcrh ! call adv_x then adv_y (=1) or the opposite (=0) 262 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: put ! i-direction ice velocity at U-point [m/s] 263 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 264 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 265 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 266 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 284 267 !! 285 INTEGER :: ji, jj 286 REAL(wp) :: zs1max, z rdt, zslpmax, ztemp! local scalars268 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 269 REAL(wp) :: zs1max, zslpmax, ztemp ! local scalars 287 270 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 288 271 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 291 274 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 292 275 !----------------------------------------------------------------------- 293 294 ! Limitation of moments. 295 296 zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 297 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 301 zs1max = 1.5 * zslpmax 302 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 303 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 304 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 305 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 306 307 ps0 (ji,jj) = zslpmax 308 psx (ji,jj) = zs1new * rswitch 309 psxx(ji,jj) = zs2new * rswitch 310 psy (ji,jj) = psy (ji,jj) * rswitch 311 psyy(ji,jj) = psyy(ji,jj) * rswitch 312 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 313 END DO 276 ! 277 jcat = SIZE( ps0 , 3 ) ! size of input arrays 278 ! 279 DO jl = 1, jcat ! loop on categories 280 ! 281 ! Limitation of moments. 282 DO jj = 2, jpjm1 283 DO ji = 1, jpi 284 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 285 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 286 ! 287 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 288 zs1max = 1.5 * zslpmax 289 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 290 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 291 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 292 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 293 294 ps0 (ji,jj,jl) = zslpmax 295 psx (ji,jj,jl) = zs1new * rswitch 296 psxx(ji,jj,jl) = zs2new * rswitch 297 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 298 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 299 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 300 END DO 301 END DO 302 303 ! Calculate fluxes and moments between boxes i<-->i+1 304 DO jj = 2, jpjm1 ! Flux from i to i+1 WHEN u GT 0 305 DO ji = 1, jpi 306 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 307 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 308 zalfq = zalf * zalf 309 zalf1 = 1.0 - zalf 310 zalf1q = zalf1 * zalf1 311 ! 312 zfm (ji,jj) = zalf * psm (ji,jj,jl) 313 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 314 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 315 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 316 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 317 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 318 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 319 320 ! Readjust moments remaining in the box. 321 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 322 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 323 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 324 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 325 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 326 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 327 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 328 END DO 329 END DO 330 331 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 332 DO ji = 1, fs_jpim1 333 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 334 zalg (ji,jj) = zalf 335 zalfq = zalf * zalf 336 zalf1 = 1.0 - zalf 337 zalg1 (ji,jj) = zalf1 338 zalf1q = zalf1 * zalf1 339 zalg1q(ji,jj) = zalf1q 340 ! 341 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 342 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 343 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 344 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 345 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 346 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 347 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 348 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 349 END DO 350 END DO 351 352 DO jj = 2, jpjm1 ! Readjust moments remaining in the box. 353 DO ji = fs_2, fs_jpim1 354 zbt = zbet(ji-1,jj) 355 zbt1 = 1.0 - zbet(ji-1,jj) 356 ! 357 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 358 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 359 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 360 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 361 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 362 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 363 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 364 END DO 365 END DO 366 367 ! Put the temporary moments into appropriate neighboring boxes. 368 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0. 369 DO ji = fs_2, fs_jpim1 370 zbt = zbet(ji-1,jj) 371 zbt1 = 1.0 - zbet(ji-1,jj) 372 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 373 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 374 zalf1 = 1.0 - zalf 375 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 376 ! 377 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 378 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 379 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 380 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 381 & + zbt1 * psxx(ji,jj,jl) 382 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 383 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 384 & + zbt1 * psxy(ji,jj,jl) 385 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 386 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 387 END DO 388 END DO 389 390 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0. 391 DO ji = fs_2, fs_jpim1 392 zbt = zbet(ji,jj) 393 zbt1 = 1.0 - zbet(ji,jj) 394 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 395 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 396 zalf1 = 1.0 - zalf 397 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 398 ! 399 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 400 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 401 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 402 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 403 & + ( zalf1 - zalf ) * ztemp ) ) 404 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 405 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 406 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 407 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 408 END DO 409 END DO 410 314 411 END DO 315 412 316 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)317 psm (:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )318 319 ! Calculate fluxes and moments between boxes i<-->i+1320 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0321 DO ji = 1, jpi322 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )323 zalf = MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)324 zalfq = zalf * zalf325 zalf1 = 1.0 - zalf326 zalf1q = zalf1 * zalf1327 !328 zfm (ji,jj) = zalf * psm (ji,jj)329 zf0 (ji,jj) = zalf * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) ) )330 zfx (ji,jj) = zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )331 zfxx(ji,jj) = zalf * psxx(ji,jj) * zalfq332 zfy (ji,jj) = zalf * ( psy (ji,jj) + zalf1 * psxy(ji,jj) )333 zfxy(ji,jj) = zalfq * psxy(ji,jj)334 zfyy(ji,jj) = zalf * psyy(ji,jj)335 336 ! Readjust moments remaining in the box.337 psm (ji,jj) = psm (ji,jj) - zfm(ji,jj)338 ps0 (ji,jj) = ps0 (ji,jj) - zf0(ji,jj)339 psx (ji,jj) = zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )340 psxx(ji,jj) = zalf1 * zalf1q * psxx(ji,jj)341 psy (ji,jj) = psy (ji,jj) - zfy(ji,jj)342 psyy(ji,jj) = psyy(ji,jj) - zfyy(ji,jj)343 psxy(ji,jj) = zalf1q * psxy(ji,jj)344 END DO345 END DO346 347 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0.348 DO ji = 1, fs_jpim1349 zalf = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)350 zalg (ji,jj) = zalf351 zalfq = zalf * zalf352 zalf1 = 1.0 - zalf353 zalg1 (ji,jj) = zalf1354 zalf1q = zalf1 * zalf1355 zalg1q(ji,jj) = zalf1q356 !357 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj)358 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )359 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )360 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj) * zalfq361 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) )362 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj)363 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj)364 END DO365 END DO366 367 DO jj = 2, jpjm1 ! Readjust moments remaining in the box.368 DO ji = fs_2, fs_jpim1369 zbt = zbet(ji-1,jj)370 zbt1 = 1.0 - zbet(ji-1,jj)371 !372 psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )373 ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )374 psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )375 psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)376 psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )377 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )378 psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)379 END DO380 END DO381 382 ! Put the temporary moments into appropriate neighboring boxes.383 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0.384 DO ji = fs_2, fs_jpim1385 zbt = zbet(ji-1,jj)386 zbt1 = 1.0 - zbet(ji-1,jj)387 psm(ji,jj) = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)388 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj)389 zalf1 = 1.0 - zalf390 ztemp = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)391 !392 ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj)393 psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)394 psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj) &395 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) &396 & + zbt1 * psxx(ji,jj)397 psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj) &398 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj) ) ) &399 & + zbt1 * psxy(ji,jj)400 psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)401 psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)402 END DO403 END DO404 405 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0.406 DO ji = fs_2, fs_jpim1407 zbt = zbet(ji,jj)408 zbt1 = 1.0 - zbet(ji,jj)409 psm(ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )410 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj)411 zalf1 = 1.0 - zalf412 ztemp = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)413 !414 ps0(ji,jj) = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )415 psx(ji,jj) = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )416 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj) &417 & + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) ) &418 & + ( zalf1 - zalf ) * ztemp ) )419 psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj) &420 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) ) )421 psy(ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )422 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )423 END DO424 END DO425 426 413 !-- Lateral boundary conditions 427 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T', 1., ps0 , 'T', 1. & 428 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 429 & , psxx, 'T', 1., psyy, 'T', 1. & 430 & , psxy, 'T', 1. ) 431 432 IF(ln_ctl) THEN 433 CALL prt_ctl(tab2d_1=psm , clinfo1=' adv_x: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 434 CALL prt_ctl(tab2d_1=psx , clinfo1=' adv_x: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 435 CALL prt_ctl(tab2d_1=psy , clinfo1=' adv_x: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 436 CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_x: psxy :') 437 ENDIF 414 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 415 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 416 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 438 417 ! 439 418 END SUBROUTINE adv_x 440 419 441 420 442 SUBROUTINE adv_y( pd f, pvt , pcrh, psm , ps0 , &421 SUBROUTINE adv_y( pdt, pvt , pcrh, psm , ps0 , & 443 422 & psx, psxx, psy , psyy, psxy ) 444 423 !!--------------------------------------------------------------------- … … 448 427 !! variable on y axis 449 428 !!--------------------------------------------------------------------- 450 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for thetime step451 REAL(wp) 452 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pvt ! j-direction ice velocity at V-point [m/s]453 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psm ! area454 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: ps0 ! field to be advected455 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments456 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments429 REAL(wp) , INTENT(in ) :: pdt ! time step 430 REAL(wp) , INTENT(in ) :: pcrh ! call adv_x then adv_y (=1) or the opposite (=0) 431 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvt ! j-direction ice velocity at V-point [m/s] 432 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 433 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 434 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 435 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 457 436 !! 458 INTEGER :: ji, jj 459 REAL(wp) :: zs1max, z rdt, zslpmax, ztemp! temporary scalars437 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 438 REAL(wp) :: zs1max, zslpmax, ztemp ! temporary scalars 460 439 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 461 440 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 464 443 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 465 444 !--------------------------------------------------------------------- 466 467 ! Limitation of moments. 468 469 zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 470 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 474 zs1max = 1.5 * zslpmax 475 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 476 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 477 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 478 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 479 ! 480 ps0 (ji,jj) = zslpmax 481 psx (ji,jj) = psx (ji,jj) * rswitch 482 psxx(ji,jj) = psxx(ji,jj) * rswitch 483 psy (ji,jj) = zs1new * rswitch 484 psyy(ji,jj) = zs2new * rswitch 485 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 486 END DO 445 ! 446 jcat = SIZE( ps0 , 3 ) ! size of input arrays 447 ! 448 DO jl = 1, jcat ! loop on categories 449 ! 450 ! Limitation of moments. 451 DO jj = 1, jpj 452 DO ji = fs_2, fs_jpim1 453 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 454 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 455 ! 456 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 457 zs1max = 1.5 * zslpmax 458 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 459 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 460 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 461 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 462 ! 463 ps0 (ji,jj,jl) = zslpmax 464 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 465 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 466 psy (ji,jj,jl) = zs1new * rswitch 467 psyy(ji,jj,jl) = zs2new * rswitch 468 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 469 END DO 470 END DO 471 472 ! Calculate fluxes and moments between boxes j<-->j+1 473 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 474 DO ji = fs_2, fs_jpim1 475 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 476 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 477 zalfq = zalf * zalf 478 zalf1 = 1.0 - zalf 479 zalf1q = zalf1 * zalf1 480 ! 481 zfm (ji,jj) = zalf * psm(ji,jj,jl) 482 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 483 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 484 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 485 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 486 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 487 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 488 ! 489 ! Readjust moments remaining in the box. 490 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 491 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 492 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 493 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 494 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 495 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 496 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 497 END DO 498 END DO 499 ! 500 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 501 DO ji = fs_2, fs_jpim1 502 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 503 zalg (ji,jj) = zalf 504 zalfq = zalf * zalf 505 zalf1 = 1.0 - zalf 506 zalg1 (ji,jj) = zalf1 507 zalf1q = zalf1 * zalf1 508 zalg1q(ji,jj) = zalf1q 509 ! 510 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 511 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 512 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 513 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 514 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 515 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 516 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 517 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 518 END DO 519 END DO 520 521 ! Readjust moments remaining in the box. 522 DO jj = 2, jpjm1 523 DO ji = fs_2, fs_jpim1 524 zbt = zbet(ji,jj-1) 525 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 526 ! 527 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 528 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 529 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 530 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 531 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 532 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 533 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 534 END DO 535 END DO 536 537 ! Put the temporary moments into appropriate neighboring boxes. 538 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 539 DO ji = fs_2, fs_jpim1 540 zbt = zbet(ji,jj-1) 541 zbt1 = 1.0 - zbet(ji,jj-1) 542 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 543 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 544 zalf1 = 1.0 - zalf 545 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 546 ! 547 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 548 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 549 & + zbt1 * psy(ji,jj,jl) 550 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 551 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 552 & + zbt1 * psyy(ji,jj,jl) 553 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 554 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 555 & + zbt1 * psxy(ji,jj,jl) 556 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 557 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 558 END DO 559 END DO 560 561 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 562 DO ji = fs_2, fs_jpim1 563 zbt = zbet(ji,jj) 564 zbt1 = 1.0 - zbet(ji,jj) 565 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 566 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 567 zalf1 = 1.0 - zalf 568 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 569 ! 570 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 571 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 572 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 573 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 574 & + ( zalf1 - zalf ) * ztemp ) ) 575 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 576 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 577 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 578 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 579 END DO 580 END DO 581 487 582 END DO 488 583 489 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 490 psm(:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 491 492 ! Calculate fluxes and moments between boxes j<-->j+1 493 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 494 DO ji = 1, jpi 495 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 496 zalf = MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 497 zalfq = zalf * zalf 498 zalf1 = 1.0 - zalf 499 zalf1q = zalf1 * zalf1 500 ! 501 zfm (ji,jj) = zalf * psm(ji,jj) 502 zf0 (ji,jj) = zalf * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj) + (zalf1-zalf) * psyy(ji,jj) ) ) 503 zfy (ji,jj) = zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 504 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj) 505 zfx (ji,jj) = zalf * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 506 zfxy(ji,jj) = zalfq * psxy(ji,jj) 507 zfxx(ji,jj) = zalf * psxx(ji,jj) 508 ! 509 ! Readjust moments remaining in the box. 510 psm (ji,jj) = psm (ji,jj) - zfm(ji,jj) 511 ps0 (ji,jj) = ps0 (ji,jj) - zf0(ji,jj) 512 psy (ji,jj) = zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 513 psyy(ji,jj) = zalf1 * zalf1q * psyy(ji,jj) 514 psx (ji,jj) = psx (ji,jj) - zfx(ji,jj) 515 psxx(ji,jj) = psxx(ji,jj) - zfxx(ji,jj) 516 psxy(ji,jj) = zalf1q * psxy(ji,jj) 584 !-- Lateral boundary conditions 585 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 586 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 587 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 588 ! 589 END SUBROUTINE adv_y 590 591 592 SUBROUTINE Hsnow( pdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 593 !!------------------------------------------------------------------- 594 !! *** ROUTINE Hsnow *** 595 !! 596 !! ** Purpose : 1- Check snow load after advection 597 !! 2- Correct pond concentration to avoid a_ip > a_i 598 !! 599 !! ** Method : If snow load makes snow-ice interface to deplet below the ocean surface 600 !! then put the snow excess in the ocean 601 !! 602 !! ** Notes : This correction is crucial because of the call to routine icecor afterwards 603 !! which imposes a mini of ice thick. (rn_himin). This imposed mini can artificially 604 !! make the snow very thick (if concentration decreases drastically) 605 !! This behavior has been seen in Ultimate-Macho and supposedly it can also be true for Prather 606 !!------------------------------------------------------------------- 607 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 608 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip 609 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 610 ! 611 INTEGER :: ji, jj, jl ! dummy loop indices 612 REAL(wp) :: z1_dt, zvs_excess, zfra 613 !!------------------------------------------------------------------- 614 ! 615 z1_dt = 1._wp / pdt 616 ! 617 ! -- check snow load -- ! 618 DO jl = 1, jpl 619 DO jj = 1, jpj 620 DO ji = 1, jpi 621 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 622 ! 623 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 624 ! 625 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 626 ! put snow excess in the ocean 627 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 628 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 629 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 630 ! correct snow volume and heat content 631 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 632 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 633 ENDIF 634 ! 635 ENDIF 636 END DO 517 637 END DO 518 638 END DO 519 639 ! 520 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 521 DO ji = 1, jpi 522 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 523 zalg (ji,jj) = zalf 524 zalfq = zalf * zalf 525 zalf1 = 1.0 - zalf 526 zalg1 (ji,jj) = zalf1 527 zalf1q = zalf1 * zalf1 528 zalg1q(ji,jj) = zalf1q 529 ! 530 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1) 531 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 532 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 533 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1) * zalfq 534 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 535 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1) 536 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1) 537 END DO 538 END DO 539 540 ! Readjust moments remaining in the box. 541 DO jj = 2, jpj 542 DO ji = 1, jpi 543 zbt = zbet(ji,jj-1) 544 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 545 ! 546 psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 547 ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 548 psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 549 psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj) 550 psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 551 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 552 psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 553 END DO 554 END DO 555 556 ! Put the temporary moments into appropriate neighboring boxes. 557 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 558 DO ji = 1, jpi 559 zbt = zbet(ji,jj-1) 560 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 561 psm(ji,jj) = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 562 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj) 563 zalf1 = 1.0 - zalf 564 ztemp = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 565 ! 566 ps0(ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj) 567 psy(ji,jj) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) & 568 & + zbt1 * psy(ji,jj) 569 psyy(ji,jj) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj) & 570 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 571 & + zbt1 * psyy(ji,jj) 572 psxy(ji,jj) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj) & 573 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) ) & 574 & + zbt1 * psxy(ji,jj) 575 psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 576 psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 577 END DO 578 END DO 579 580 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 581 DO ji = 1, jpi 582 zbt = zbet(ji,jj) 583 zbt1 = ( 1.0 - zbet(ji,jj) ) 584 psm(ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 585 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj) 586 zalf1 = 1.0 - zalf 587 ztemp = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj) 588 ps0 (ji,jj) = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 589 psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 590 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj) & 591 & + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) & 592 & + ( zalf1 - zalf ) * ztemp ) ) 593 psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj) & 594 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) ) 595 psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 596 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 597 END DO 598 END DO 599 600 !-- Lateral boundary conditions 601 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T', 1., ps0 , 'T', 1. & 602 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 603 & , psxx, 'T', 1., psyy, 'T', 1. & 604 & , psxy, 'T', 1. ) 605 606 IF(ln_ctl) THEN 607 CALL prt_ctl(tab2d_1=psm , clinfo1=' adv_y: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 608 CALL prt_ctl(tab2d_1=psx , clinfo1=' adv_y: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 609 CALL prt_ctl(tab2d_1=psy , clinfo1=' adv_y: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 610 CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_y: psxy :') 611 ENDIF 612 ! 613 END SUBROUTINE adv_y 640 !-- correct pond concentration to avoid a_ip > a_i -- ! 641 WHERE( pa_ip(:,:,:) > pa_i(:,:,:) ) pa_ip(:,:,:) = pa_i(:,:,:) 642 ! 643 END SUBROUTINE Hsnow 614 644 615 645 … … 624 654 ! 625 655 ! !* allocate prather fields 626 ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , & 627 & sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 656 ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 628 657 & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & 629 658 & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & … … 652 681 !! *** ROUTINE adv_pra_rst *** 653 682 !! 654 !! ** Purpose : Read or write RHGfile in restart file683 !! ** Purpose : Read or write file in restart file 655 684 !! 656 685 !! ** Method : use of IOM library … … 671 700 ! !==========================! 672 701 ! 673 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sx opw' , ldstop = .FALSE. ) ! file exist: id1>0702 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sxice' , ldstop = .FALSE. ) ! file exist: id1>0 674 703 ELSE ; id1 = 0 ! no restart: id1=0 675 704 ENDIF … … 689 718 CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn ) 690 719 CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn ) 691 ! ! lead fraction720 ! ! ice concentration 692 721 CALL iom_get( numrir, jpdom_autoglo, 'sxa' , sxa ) 693 722 CALL iom_get( numrir, jpdom_autoglo, 'sya' , sya ) … … 707 736 CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 708 737 CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 709 ! ! open water in sea ice710 CALL iom_get( numrir, jpdom_autoglo, 'sxopw' , sxopw )711 CALL iom_get( numrir, jpdom_autoglo, 'syopw' , syopw )712 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw )713 CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw )714 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw )715 738 ! ! snow layers heat content 716 739 DO jk = 1, nlay_s … … 752 775 sxice = 0._wp ; syice = 0._wp ; sxxice = 0._wp ; syyice = 0._wp ; sxyice = 0._wp ! ice thickness 753 776 sxsn = 0._wp ; sysn = 0._wp ; sxxsn = 0._wp ; syysn = 0._wp ; sxysn = 0._wp ! snow thickness 754 sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! lead fraction777 sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! ice concentration 755 778 sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity 756 779 sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age 757 sxopw = 0._wp ; syopw = 0._wp ; sxxopw = 0._wp ; syyopw = 0._wp ; sxyopw = 0._wp ! open water in sea ice758 780 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content 759 781 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content … … 786 808 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn ) 787 809 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn ) 788 ! ! lead fraction810 ! ! ice concentration 789 811 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa ) 790 812 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya ) … … 804 826 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage ) 805 827 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage ) 806 ! ! open water in sea ice807 CALL iom_rstput( iter, nitrst, numriw, 'sxopw' , sxopw )808 CALL iom_rstput( iter, nitrst, numriw, 'syopw' , syopw )809 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw )810 CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw )811 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw )812 828 ! ! snow layers heat content 813 829 DO jk = 1, nlay_s -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_adv_umx.F90
r10945 r12143 83 83 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: poa_i ! age content 84 84 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_i ! ice concentration 85 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction85 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond concentration 86 86 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 87 87 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content … … 319 319 ! 320 320 !== Ice age ==! 321 IF( iom_use('iceage') .OR. iom_use('iceage_cat') ) THEN 322 zamsk = 1._wp 323 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 324 & poa_i, poa_i ) 325 ENDIF 321 zamsk = 1._wp 322 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 323 & poa_i, poa_i ) 326 324 ! 327 325 !== melt ponds ==! 328 326 IF ( ln_pnd_H12 ) THEN 329 ! fraction327 ! concentration 330 328 zamsk = 1._wp 331 329 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, & … … 1529 1527 !! 3- check whether snow load deplets the snow-ice interface below sea level$ 1530 1528 !! and reduce it by sending the excess in the ocean 1531 !! 4- correct pond fraction to avoid a_ip > a_i1529 !! 4- correct pond concentration to avoid a_ip > a_i 1532 1530 !! 1533 1531 !! ** input : Max thickness of the surrounding 9-points … … 1599 1597 END DO 1600 1598 END DO 1601 ! !-- correct pond fraction to avoid a_ip > a_i1599 ! !-- correct pond concentration to avoid a_ip > a_i 1602 1600 WHERE( pa_ip(:,:,:) > pa_i(:,:,:) ) pa_ip(:,:,:) = pa_i(:,:,:) 1603 1601 ! -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_rdgrft.F90
r10994 r12143 86 86 !! *** ROUTINE ice_dyn_rdgrft_alloc *** 87 87 !!------------------------------------------------------------------- 88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij),&89 & apartf(jpij,0:jpl) , hrmin(jpij,jpl), hraft(jpij,jpl) , aridge(jpij,jpl),&90 & hrmax (jpij,jpl), hi_hrdg(jpij,jpl) , araft (jpij,jpl),&88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij) , & 89 & apartf(jpij,0:jpl) , hrmin (jpij,jpl) , hraft(jpij,jpl) , aridge(jpij,jpl), & 90 & hrmax (jpij,jpl) , hi_hrdg(jpij,jpl) , araft(jpij,jpl) , & 91 91 & ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc ) 92 92 … … 137 137 REAL(wp) :: zfac ! local scalar 138 138 INTEGER , DIMENSION(jpij) :: iptidx ! compute ridge/raft or not 139 REAL(wp), DIMENSION(jpij) :: zdivu_adv ! divu as implied by transport scheme (1/s)140 139 REAL(wp), DIMENSION(jpij) :: zdivu, zdelt ! 1D divu_i & delta_i 141 140 ! … … 145 144 IF( ln_timing ) CALL timing_start('icedyn_rdgrft') ! timing 146 145 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 146 IF( ln_icediachk ) CALL ice_cons2D (0, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 147 147 148 148 IF( kt == nit000 ) THEN … … 174 174 175 175 ! just needed here 176 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i )177 176 CALL tab_2d_1d( npti, nptidx(1:npti), zdelt (1:npti) , delta_i ) 178 177 ! needed here and in the iteration loop 178 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i) ! zdivu is used as a work array here (no change in divu_i) 179 179 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 180 180 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) … … 186 186 closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 187 187 ! 188 ! divergence given by the advection scheme 189 ! (which may not be equal to divu as computed from the velocity field) 190 IF ( ln_adv_Pra ) THEN 191 zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice 192 ELSEIF( ln_adv_UMx ) THEN 193 zdivu_adv(ji) = zdivu(ji) 194 ENDIF 195 ! 196 IF( zdivu_adv(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) ) ! make sure the closing rate is large enough 197 ! ! to give asum = 1.0 after ridging 188 IF( zdivu(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) ) ! make sure the closing rate is large enough 189 ! ! to give asum = 1.0 after ridging 198 190 ! Opening rate (non-negative) that will give asum = 1.0 after ridging. 199 opning(ji) = closing_net(ji) + zdivu _adv(ji)191 opning(ji) = closing_net(ji) + zdivu(ji) 200 192 END DO 201 193 ! … … 214 206 ato_i_1d (ipti) = ato_i_1d (ji) 215 207 closing_net(ipti) = closing_net(ji) 216 zdivu _adv (ipti) = zdivu_adv(ji)208 zdivu (ipti) = zdivu (ji) 217 209 opning (ipti) = opning (ji) 218 210 ENDIF … … 258 250 ELSE 259 251 iterate_ridging = 1 260 zdivu _adv(ji) = zfac * r1_rdtice261 closing_net(ji) = MAX( 0._wp, -zdivu _adv(ji) )262 opning (ji) = MAX( 0._wp, zdivu _adv(ji) )252 zdivu (ji) = zfac * r1_rdtice 253 closing_net(ji) = MAX( 0._wp, -zdivu(ji) ) 254 opning (ji) = MAX( 0._wp, zdivu(ji) ) 263 255 ENDIF 264 256 END DO … … 276 268 277 269 ! controls 270 IF( ln_ctl ) CALL ice_prt3D ('icedyn_rdgrft') ! prints 271 IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ') ! prints 278 272 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') ! prints273 IF( ln_icediachk ) CALL ice_cons2D (1, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 280 274 IF( ln_timing ) CALL timing_stop ('icedyn_rdgrft') ! timing 281 275 ! … … 306 300 307 301 ! ! Ice thickness needed for rafting 308 WHERE( pa_i(1:npti,:) > epsi 20 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)302 WHERE( pa_i(1:npti,:) > epsi10 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 309 303 ELSEWHERE ; zhi(1:npti,:) = 0._wp 310 304 END WHERE … … 325 319 zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 ) 326 320 ! 327 WHERE( zasum(1:npti) > epsi 20 ) ; z1_asum(1:npti) = 1._wp / zasum(1:npti)321 WHERE( zasum(1:npti) > epsi10 ) ; z1_asum(1:npti) = 1._wp / zasum(1:npti) 328 322 ELSEWHERE ; z1_asum(1:npti) = 0._wp 329 323 END WHERE … … 451 445 ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate. 452 446 ! NOTE: 0 < aksum <= 1 453 WHERE( zaksum(1:npti) > epsi 20 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)447 WHERE( zaksum(1:npti) > epsi10 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti) 454 448 ELSEWHERE ; closing_gross(1:npti) = 0._wp 455 449 END WHERE … … 534 528 IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN ! only if ice is ridging 535 529 536 IF( a_i_2d(ji,jl1) > epsi 20 ) THEN ; z1_ai(ji) = 1._wp / a_i_2d(ji,jl1)530 IF( a_i_2d(ji,jl1) > epsi10 ) THEN ; z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 537 531 ELSE ; z1_ai(ji) = 0._wp 538 532 ENDIF … … 592 586 ! virtual salt flux to keep salinity constant 593 587 IF( nn_icesal /= 2 ) THEN 594 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) 588 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) ! ridge salinity = s_i 595 589 sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_rdtice & ! put back sss_m into the ocean 596 590 & - s_i_1d(ji) * vsw * rhoi * r1_rdtice ! and get s_i from the ocean … … 916 910 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 917 911 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)912 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 919 913 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 920 914 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)915 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 922 916 IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 923 917 ! -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_rhg.F90
r10911 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_rhg_evp.F90
r10891 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/iceistate.F90
r11229 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/iceitd.F90
r10994 r12143 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 !----------------------------------------------------------------------------------------------- … … 210 211 CALL itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in 211 212 & g0 (1:npti,1), g1 (1:npti,1), hL (1:npti,1), hR (1:npti,1) ) ! out 212 213 ! 213 214 ! Area lost due to melting of thin ice 214 215 DO ji = 1, npti … … 217 218 ! 218 219 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 219 IF( zdh0 < 0.0 ) THEN ! remove area from category 1220 IF( zdh0 < 0.0 ) THEN ! remove area from category 1 220 221 zdh0 = MIN( -zdh0, hi_max(1) ) 221 222 !Integrate g(1) from 0 to dh0 to estimate area melted … … 225 226 zx1 = zetamax 226 227 zx2 = 0.5 * zetamax * zetamax 227 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 228 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 ! ice area removed 228 229 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 229 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting 230 ! of thin ice (zdamax > 0) 230 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting of thin ice (zdamax > 0) 231 231 ! Remove area, conserving volume 232 232 h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 ) … … 316 316 ! 317 317 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 318 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 318 319 ! 319 320 END SUBROUTINE ice_itd_rem … … 347 348 DO ji = 1, npti 348 349 ! 349 IF( paice(ji) > epsi10 .AND. phice(ji) > 0._wp) THEN350 IF( paice(ji) > epsi10 .AND. phice(ji) > epsi10 ) THEN 350 351 ! 351 352 ! Initialize hL and hR … … 586 587 ! 587 588 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 589 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 588 590 ! 589 591 jdonor(:,:) = 0 … … 664 666 ! 665 667 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 668 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 666 669 ! 667 670 END SUBROUTINE ice_itd_reb … … 685 688 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice 686 689 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 687 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' , lwp)690 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' ) 688 691 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 689 692 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 690 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' , lwp)693 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 691 694 IF(lwm) WRITE( numoni, namitd ) 692 695 ! -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icerst.F90
r10425 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icesbc.F90
r10535 r12143 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 < 1.e-03 ) 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icestp.F90
r10994 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd.F90
r10994 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd_da.F90
r10069 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd_do.F90
r11229 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd_pnd.F90
r10532 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd_sal.F90
r10069 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icethd_zdf.F90
r10534 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/iceupdate.F90
r10425 r12143 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/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icevar.F90
r11229 r12143 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 … … 609 622 pv_s (ji,jj,jl) = 0._wp 610 623 ENDIF 611 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN624 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 612 625 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 613 626 psv_i (ji,jj,jl) = 0._wp … … 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 !! 810 868 !! ** Purpose : converting 1-cat ice to jpl ice categories 811 869 !! 812 !! ice thickness distribution follows a gaussian law 813 !! around the concentration of the most likely ice thickness 814 !! (similar as iceistate.F90) 815 !! 816 !! ** Method: Iterative procedure 817 !! 818 !! 1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian 819 !! 820 !! 2) Check whether the distribution conserves area and volume, positivity and 821 !! category boundaries 870 !! 871 !! ** Method: ice thickness distribution follows a gamma function from Abraham et al. (2015) 872 !! it has the property of conserving total concentration and volume 822 873 !! 823 !! 3) If not (input ice is too thin), the last category is empty and 824 !! the number of categories is reduced (jpl-1) 825 !! 826 !! 4) Iterate until ok (SUM(itest(:) = 4) 827 !! 828 !! ** Arguments : zhti: 1-cat ice thickness 829 !! zhts: 1-cat snow depth 830 !! zati: 1-cat ice concentration 874 !! 875 !! ** Arguments : phti: 1-cat ice thickness 876 !! phts: 1-cat snow depth 877 !! pati: 1-cat ice concentration 831 878 !! 832 879 !! ** Output : jpl-cat 833 880 !! 834 !! (Example of application: BDY forcings when input are cell averaged) 835 !!------------------------------------------------------------------- 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 ! ---------------------------------------- 845 ! distribution over the jpl ice categories 846 ! ---------------------------------------- 847 ! a gaussian distribution for ice concentration is used 848 ! then we check whether the distribution fullfills 849 ! volume and area conservation, positivity and ice categories bounds 850 idim = SIZE( zhti , 1 ) 851 zh_i(1:idim,1:jpl) = 0._wp 852 zh_s(1:idim,1:jpl) = 0._wp 853 za_i(1:idim,1:jpl) = 0._wp 854 ! 881 !! Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015. 882 !! Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice. 883 !! Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 884 !!------------------------------------------------------------------- 885 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 886 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 887 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 888 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 889 ! 890 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra, z1_hti 891 INTEGER :: ji, jk, jl 892 INTEGER :: idim 893 REAL(wp) :: zv, zdh 894 !!------------------------------------------------------------------- 895 ! 896 idim = SIZE( phti , 1 ) 897 ! 898 ph_i(1:idim,1:jpl) = 0._wp 899 ph_s(1:idim,1:jpl) = 0._wp 900 pa_i(1:idim,1:jpl) = 0._wp 901 ! 902 ALLOCATE( z1_hti(idim) ) 903 WHERE( phti(:) /= 0._wp ) ; z1_hti(:) = 1._wp / phti(:) 904 ELSEWHERE ; z1_hti(:) = 0._wp 905 END WHERE 906 ! 907 ! == thickness and concentration == ! 908 ! for categories 1:jpl-1, integrate the gamma function from hi_max(jl-1) to hi_max(jl) 909 DO jl = 1, jpl-1 910 DO ji = 1, idim 911 ! 912 IF( phti(ji) > 0._wp ) THEN 913 ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 914 pa_i(ji,jl) = pati(ji) * z1_hti(ji) * ( ( phti(ji) + 2.*hi_max(jl-1) ) * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 915 & - ( phti(ji) + 2.*hi_max(jl ) ) * EXP( -2.*hi_max(jl )*z1_hti(ji) ) ) 916 ! 917 ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 918 zv = pati(ji) * z1_hti(ji) * ( ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl-1) + 2.*hi_max(jl-1)*hi_max(jl-1) ) & 919 & * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 920 & - ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl) + 2.*hi_max(jl)*hi_max(jl) ) & 921 & * EXP(-2.*hi_max(jl)*z1_hti(ji)) ) 922 ! thickness 923 IF( pa_i(ji,jl) > epsi06 ) THEN 924 ph_i(ji,jl) = zv / pa_i(ji,jl) 925 ELSE 926 ph_i(ji,jl) = 0. 927 pa_i(ji,jl) = 0. 928 ENDIF 929 ENDIF 930 ! 931 ENDDO 932 ENDDO 933 ! 934 ! for the last category (jpl), integrate the gamma function from hi_max(jpl-1) to infinity 855 935 DO ji = 1, idim 856 936 ! 857 IF( zhti(ji) > 0._wp ) THEN 858 ! 859 ! find which category (jl0) the input ice thickness falls into 860 jl0 = jpl 861 DO jl = 1, jpl 862 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 863 jl0 = jl 864 CYCLE 865 ENDIF 866 END DO 867 ! 868 itest(:) = 0 869 i_fill = jpl + 1 !------------------------------------ 870 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 871 ! !------------------------------------ 872 i_fill = i_fill - 1 873 ! 874 zh_i(ji,1:jpl) = 0._wp 875 za_i(ji,1:jpl) = 0._wp 876 itest(:) = 0 877 ! 878 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) 881 ELSE !-- case ice is thicker: fill categories >1 882 ! thickness 883 DO jl = 1, i_fill - 1 884 zh_i(ji,jl) = hi_mean(jl) 885 END DO 886 ! 887 ! concentration 888 za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl)) 889 DO jl = 1, i_fill - 1 890 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) 893 ENDIF 894 END DO 895 ! 896 ! 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 ) 900 ! 901 ! correction if concentration of upper cat is greater than lower cat 902 ! (it should be a gaussian around jl0 but sometimes it is not) 903 IF ( jl0 /= jpl ) THEN 904 DO jl = jpl, jl0+1, -1 905 IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 906 zdv = zh_i(ji,jl) * za_i(ji,jl) 907 zh_i(ji,jl ) = 0._wp 908 za_i (ji,jl ) = 0._wp 909 za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 910 END IF 911 END DO 912 ENDIF 913 ! 914 ENDIF 915 ! 916 ! Compatibility tests 917 zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) ) 918 IF ( zconv < epsi06 ) itest(1) = 1 ! Test 1: area conservation 919 ! 920 zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) ) 921 IF ( zconv < epsi06 ) itest(2) = 1 ! Test 2: volume conservation 922 ! 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 ? 924 ! 925 itest(4) = 1 926 DO jl = 1, i_fill 927 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 ! Test 4: positivity of ice concentrations 928 END DO 929 ! !---------------------------- 930 END DO ! end iteration on categories 931 ! !---------------------------- 937 IF( phti(ji) > 0._wp ) THEN 938 ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jpl-1) to infinity 939 pa_i(ji,jpl) = pati(ji) * z1_hti(ji) * ( phti(ji) + 2.*hi_max(jpl-1) ) * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 940 941 ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jpl-1) to infinity 942 zv = pati(ji) * z1_hti(ji) * ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jpl-1) + 2.*hi_max(jpl-1)*hi_max(jpl-1) ) & 943 & * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 944 ! thickness 945 IF( pa_i(ji,jpl) > epsi06 ) THEN 946 ph_i(ji,jpl) = zv / pa_i(ji,jpl) 947 else 948 ph_i(ji,jpl) = 0. 949 pa_i(ji,jpl) = 0. 950 ENDIF 932 951 ENDIF 933 END DO 934 935 ! Add Snow in each category where za_i is not 0 952 ! 953 ENDDO 954 ! 955 ! Add Snow in each category where pa_i is not 0 936 956 DO jl = 1, jpl 937 957 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))958 IF( pa_i(ji,jl) > 0._wp ) THEN 959 ph_s(ji,jl) = ph_i(ji,jl) * phts(ji) * z1_hti(ji) 940 960 ! In case snow load is in excess that would lead to transformation from snow to ice 941 961 ! 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 )962 zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 ) 943 963 ! 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 )964 ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 965 ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 946 966 ENDIF 947 967 END DO 948 968 END DO 949 969 ! 970 DEALLOCATE( z1_hti ) 971 ! 972 ! == temperature and salinity == ! 973 DO jl = 1, jpl 974 pt_i (:,jl) = ptmi (:) 975 pt_s (:,jl) = ptms (:) 976 pt_su(:,jl) = ptmsu(:) 977 ps_i (:,jl) = psmi (:) 978 ps_i (:,jl) = psmi (:) 979 END DO 980 ! 981 ! == ponds == ! 982 ALLOCATE( zfra(idim) ) 983 ! keep the same pond fraction atip/ati for each category 984 WHERE( pati(:) /= 0._wp ) ; zfra(:) = patip(:) / pati(:) 985 ELSEWHERE ; zfra(:) = 0._wp 986 END WHERE 987 DO jl = 1, jpl 988 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 989 END DO 990 ! keep the same v_ip/v_i ratio for each category 991 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 992 ELSEWHERE ; zfra(:) = 0._wp 993 END WHERE 994 DO jl = 1, jpl 995 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 996 ELSEWHERE ; ph_ip(:,jl) = 0._wp 997 END WHERE 998 END DO 999 DEALLOCATE( zfra ) 1000 ! 950 1001 END SUBROUTINE ice_var_itd_1cMc 951 1002 952 SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 1003 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1004 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 953 1005 !!------------------------------------------------------------------- 954 1006 !! … … 971 1023 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 972 1024 !! 973 !! ** Arguments : zhti: N-cat ice thickness974 !! zhts: N-cat snow depth975 !! zati: N-cat ice concentration1025 !! ** Arguments : phti: N-cat ice thickness 1026 !! phts: N-cat snow depth 1027 !! pati: N-cat ice concentration 976 1028 !! 977 1029 !! ** Output : jpl-cat … … 979 1031 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 980 1032 !!------------------------------------------------------------------- 981 INTEGER :: ji, jl, jl1, jl2 ! dummy loop indices 1033 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1034 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1035 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 1036 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 1037 ! 1038 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 1039 INTEGER , ALLOCATABLE, DIMENSION(:) :: jlmax, jlmin 1040 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp, zfra 1041 ! 1042 REAL(wp), PARAMETER :: ztrans = 0.25_wp 1043 INTEGER :: ji, jl, jl1, jl2 982 1044 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 ) 1045 !!------------------------------------------------------------------- 1046 ! 1047 idim = SIZE( phti, 1 ) 1048 icat = SIZE( phti, 2 ) 1049 ! 1050 ! == thickness and concentration == ! 992 1051 ! ! ---------------------- ! 993 1052 IF( icat == jpl ) THEN ! input cat = output cat ! 994 1053 ! ! ---------------------- ! 995 zh_i(:,:) = zhti(:,:) 996 zh_s(:,:) = zhts(:,:) 997 za_i(:,:) = zati(:,:) 1054 ph_i(:,:) = phti(:,:) 1055 ph_s(:,:) = phts(:,:) 1056 pa_i(:,:) = pati(:,:) 1057 ! 1058 ! == temperature and salinity and ponds == ! 1059 pt_i (:,:) = ptmi (:,:) 1060 pt_s (:,:) = ptms (:,:) 1061 pt_su(:,:) = ptmsu(:,:) 1062 ps_i (:,:) = psmi (:,:) 1063 pa_ip(:,:) = patip(:,:) 1064 ph_ip(:,:) = phtip(:,:) 998 1065 ! ! ---------------------- ! 999 1066 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1000 1067 ! ! ---------------------- ! 1001 CALL ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i(:,:), zh_s(:,:), za_i(:,:) ) 1068 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1069 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1070 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 1071 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) ) 1002 1072 ! ! ---------------------- ! 1003 1073 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1004 1074 ! ! ---------------------- ! 1005 CALL ice_var_itd_Nc1c( zhti(:,:), zhts(:,:), zati(:,:), zh_i(:,1), zh_s(:,1), za_i(:,1) ) 1075 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1076 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1077 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 1078 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) ) 1006 1079 ! ! ----------------------- ! 1007 1080 ELSE ! input cat /= output cat ! … … 1012 1085 1013 1086 ! --- 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._wp1087 ph_i(1:idim,1:jpl) = 0._wp 1088 ph_s(1:idim,1:jpl) = 0._wp 1089 pa_i(1:idim,1:jpl) = 0._wp 1017 1090 ! 1018 1091 ! --- fill the categories --- ! … … 1024 1097 DO jl2 = 1, icat 1025 1098 DO ji = 1, idim 1026 IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN1099 IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 1027 1100 ! 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)1101 ph_i(ji,jl1) = phti(ji,jl2) 1102 ph_s(ji,jl1) = phts(ji,jl2) 1103 pa_i(ji,jl1) = pati(ji,jl2) 1031 1104 ! record categories that are filled 1032 1105 jlmax(ji) = MAX( jlmax(ji), jl1 ) … … 1045 1118 IF( jl1 > 1 ) THEN 1046 1119 ! 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)1120 pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 1121 ph_i(ji,jl1-1) = hi_mean(jl1-1) 1049 1122 ! remove from cat jl1 1050 za_i(ji,jl1 ) = ( 1._wp - ztrans ) * za_i(ji,jl1)1123 pa_i(ji,jl1 ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 1051 1124 ENDIF 1052 1125 IF( jl2 < jpl ) THEN 1053 1126 ! 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)1127 pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 1128 ph_i(ji,jl2+1) = hi_mean(jl2+1) 1056 1129 ! remove from cat jl2 1057 za_i(ji,jl2 ) = ( 1._wp - ztrans ) * za_i(ji,jl2)1130 pa_i(ji,jl2 ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 1058 1131 ENDIF 1059 1132 END DO … … 1065 1138 IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 1066 1139 ! fill high 1067 za_i(ji,jl) = ztrans * za_i(ji,jl-1)1068 zh_i(ji,jl) = hi_mean(jl)1140 pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 1141 ph_i(ji,jl) = hi_mean(jl) 1069 1142 jlfil(ji,jl) = jl 1070 1143 ! remove low 1071 za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1)1144 pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 1072 1145 ENDIF 1073 1146 END DO … … 1079 1152 IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 1080 1153 ! 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)1154 pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 1155 ph_i(ji,jl) = hi_mean(jl) 1083 1156 jlfil2(ji,jl) = jl 1084 1157 ! remove high 1085 za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1)1158 pa_i(ji,jl+1) = ( 1._wp - ztrans ) * pa_i(ji,jl+1) 1086 1159 ENDIF 1087 1160 END DO … … 1090 1163 DEALLOCATE( jlfil, jlfil2 ) ! deallocate arrays 1091 1164 DEALLOCATE( jlmin, jlmax ) 1165 ! 1166 ! == temperature and salinity == ! 1167 ! 1168 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1169 ! 1170 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1171 ELSEWHERE ; z1_ai(:) = 0._wp 1172 END WHERE 1173 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1174 ELSEWHERE ; z1_vi(:) = 0._wp 1175 END WHERE 1176 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1177 ELSEWHERE ; z1_vs(:) = 0._wp 1178 END WHERE 1179 ! 1180 ! fill all the categories with the same value 1181 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1182 DO jl = 1, jpl 1183 pt_i (:,jl) = ztmp(:) 1184 END DO 1185 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1186 DO jl = 1, jpl 1187 pt_s (:,jl) = ztmp(:) 1188 END DO 1189 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1190 DO jl = 1, jpl 1191 pt_su(:,jl) = ztmp(:) 1192 END DO 1193 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1194 DO jl = 1, jpl 1195 ps_i (:,jl) = ztmp(:) 1196 END DO 1197 ! 1198 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1199 ! 1200 ! == ponds == ! 1201 ALLOCATE( zfra(idim) ) 1202 ! keep the same pond fraction atip/ati for each category 1203 WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp ) ; zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 1204 ELSEWHERE ; zfra(:) = 0._wp 1205 END WHERE 1206 DO jl = 1, jpl 1207 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1208 END DO 1209 ! keep the same v_ip/v_i ratio for each category 1210 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1211 zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1212 ELSEWHERE 1213 zfra(:) = 0._wp 1214 END WHERE 1215 DO jl = 1, jpl 1216 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1217 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1218 END WHERE 1219 END DO 1220 DEALLOCATE( zfra ) 1092 1221 ! 1093 1222 ENDIF -
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icewri.F90
r10911 r12143 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 166 IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 167 167 168 168 !------------------ … … 170 170 !------------------ 171 171 ! 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 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 thermodynamics 173 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 water 175 IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth 176 IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion 177 IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting 178 IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting 179 IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation 180 IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation 181 IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation 182 IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall 183 IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion 184 IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt 185 IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) 186 187 187 ! 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 ) 188 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & 189 & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN 190 ! 191 WHERE( ff_t(:,:) > 0._wp ) ; z2d(:,:) = 1._wp 192 ELSEWHERE ; z2d(:,:) = 0. 193 END WHERE 194 ! 195 IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i * z2d * e1e2t * 1.e-12 ) 196 IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i * z2d * e1e2t * 1.e-12 ) 197 IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t * 1.e-12 * zmsk15 ) 198 ! 199 IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 200 IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 201 IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 ) 202 ! 203 CALL iom_put( 'NH_icearea' , zdiag_area_nh ) 204 CALL iom_put( 'NH_icevolu' , zdiag_volu_nh ) 205 CALL iom_put( 'NH_iceextt' , zdiag_extt_nh ) 206 CALL iom_put( 'SH_icearea' , zdiag_area_sh ) 207 CALL iom_put( 'SH_icevolu' , zdiag_volu_sh ) 208 CALL iom_put( 'SH_iceextt' , zdiag_extt_sh ) 204 209 ! 205 210 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 211 ! 226 212 !!CR ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 227 213 !!CR ! IF( kindic < 0 ) CALL ice_wri_state( 'output.abort' ) 228 214 !!CR ! not yet implemented 229 !!gm idem for the ocean... Ask Seb how to get r ead of ioipsl....215 !!gm idem for the ocean... Ask Seb how to get rid of ioipsl.... 230 216 ! 231 217 IF( ln_timing ) CALL timing_stop('icewri')
Note: See TracChangeset
for help on using the changeset viewer.