| 1 | MODULE limthd_2 |
|---|
| 2 | !!====================================================================== |
|---|
| 3 | !! *** MODULE limthd_2 *** |
|---|
| 4 | !! LIM thermo ice model : ice thermodynamic |
|---|
| 5 | !!====================================================================== |
|---|
| 6 | !! History : 1.0 ! 2000-01 (LIM) |
|---|
| 7 | !! 2.0 ! 2002-07 (C. Ethe, G. Madec) F90 |
|---|
| 8 | !! 2.0 ! 2003-08 (C. Ethe) add lim_thd_init |
|---|
| 9 | !! - ! 2008-2008 (A. Caubel, G. Madec, E. Maisonnave, S. Masson ) generic coupled interface |
|---|
| 10 | !!--------------------------------------------------------------------- |
|---|
| 11 | #if defined key_lim2 |
|---|
| 12 | !!---------------------------------------------------------------------- |
|---|
| 13 | !! 'key_lim2' : LIM 2.0 sea-ice model |
|---|
| 14 | !!---------------------------------------------------------------------- |
|---|
| 15 | !! lim_thd_2 : thermodynamic of sea ice |
|---|
| 16 | !! lim_thd_init_2 : initialisation of sea-ice thermodynamic |
|---|
| 17 | !!---------------------------------------------------------------------- |
|---|
| 18 | USE phycst ! physical constants |
|---|
| 19 | USE dom_oce ! ocean space and time domain variables |
|---|
| 20 | USE domvvl ! ocean domain |
|---|
| 21 | USE ice_2 ! LIM sea-ice variables |
|---|
| 22 | USE sbc_oce ! surface boundary condition: ocean |
|---|
| 23 | USE sbc_ice ! surface boundary condition: sea-ice |
|---|
| 24 | USE thd_ice_2 ! LIM thermodynamic sea-ice variables |
|---|
| 25 | USE dom_ice_2 ! LIM sea-ice domain |
|---|
| 26 | USE limthd_zdf_2 ! |
|---|
| 27 | USE limthd_lac_2 ! |
|---|
| 28 | USE limtab_2 ! |
|---|
| 29 | ! |
|---|
| 30 | USE in_out_manager ! I/O manager |
|---|
| 31 | USE lbclnk ! |
|---|
| 32 | USE lib_mpp ! |
|---|
| 33 | USE iom ! IOM library |
|---|
| 34 | USE prtctl ! Print control |
|---|
| 35 | USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) |
|---|
| 36 | |
|---|
| 37 | IMPLICIT NONE |
|---|
| 38 | PRIVATE |
|---|
| 39 | |
|---|
| 40 | PUBLIC lim_thd_2 ! called by lim_step |
|---|
| 41 | |
|---|
| 42 | REAL(wp) :: epsi20 = 1.e-20 ! constant values |
|---|
| 43 | REAL(wp) :: epsi16 = 1.e-16 ! |
|---|
| 44 | REAL(wp) :: epsi04 = 1.e-04 ! |
|---|
| 45 | REAL(wp) :: rzero = 0._wp ! |
|---|
| 46 | REAL(wp) :: rone = 1._wp ! |
|---|
| 47 | |
|---|
| 48 | !! * Substitutions |
|---|
| 49 | # include "vectopt_loop_substitute.h90" |
|---|
| 50 | !!-------- ------------------------------------------------------------- |
|---|
| 51 | !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) |
|---|
| 52 | !! $Id$ |
|---|
| 53 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
|---|
| 54 | !!---------------------------------------------------------------------- |
|---|
| 55 | CONTAINS |
|---|
| 56 | |
|---|
| 57 | SUBROUTINE lim_thd_2( kt ) |
|---|
| 58 | !!------------------------------------------------------------------- |
|---|
| 59 | !! *** ROUTINE lim_thd_2 *** |
|---|
| 60 | !! |
|---|
| 61 | !! ** Purpose : This routine manages the ice thermodynamic. |
|---|
| 62 | !! |
|---|
| 63 | !! ** Action : - Initialisation of some variables |
|---|
| 64 | !! - Some preliminary computation (oceanic heat flux |
|---|
| 65 | !! at the ice base, snow acc.,heat budget of the leads) |
|---|
| 66 | !! - selection of the icy points and put them in an array |
|---|
| 67 | !! - call lim_vert_ther for vert ice thermodynamic |
|---|
| 68 | !! - back to the geographic grid |
|---|
| 69 | !! - selection of points for lateral accretion |
|---|
| 70 | !! - call lim_lat_acc for the ice accretion |
|---|
| 71 | !! - back to the geographic grid |
|---|
| 72 | !! |
|---|
| 73 | !! References : Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 |
|---|
| 74 | !!--------------------------------------------------------------------- |
|---|
| 75 | INTEGER, INTENT(in) :: kt ! number of iteration |
|---|
| 76 | ! |
|---|
| 77 | INTEGER :: ji, jj ! dummy loop indices |
|---|
| 78 | INTEGER :: nbpb ! nb of icy pts for thermo. cal. |
|---|
| 79 | INTEGER :: nbpac ! nb of pts for lateral accretion |
|---|
| 80 | CHARACTER (len=22) :: charout |
|---|
| 81 | REAL(wp) :: zfric_umin = 5e-03 ! lower bound for the friction velocity |
|---|
| 82 | REAL(wp) :: zfric_umax = 2e-02 ! upper bound for the friction velocity |
|---|
| 83 | REAL(wp) :: zinda ! switch for test. the val. of concen. |
|---|
| 84 | REAL(wp) :: zindb, zindg ! switches for test. the val of arg |
|---|
| 85 | REAL(wp) :: zfricp ! temporary scalar |
|---|
| 86 | REAL(wp) :: za , zh, zthsnice ! |
|---|
| 87 | REAL(wp) :: zfric_u ! friction velocity |
|---|
| 88 | REAL(wp) :: zfntlat, zpareff ! test. the val. of lead heat budget |
|---|
| 89 | |
|---|
| 90 | REAL(wp) :: zuice_m, zvice_m ! Sea-ice velocities at U & V-points |
|---|
| 91 | REAL(wp) :: zhice_u, zhice_v ! Sea-ice volume at U & V-points |
|---|
| 92 | REAL(wp) :: ztr_fram ! Sea-ice transport through Fram strait |
|---|
| 93 | REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars |
|---|
| 94 | REAL(wp) :: zztmp ! temporary scalars within a loop |
|---|
| 95 | REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! 2D workspace |
|---|
| 96 | REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif |
|---|
| 97 | REAL(wp), DIMENSION(jpi,jpj) :: zlicegr ! link with lateral ice growth |
|---|
| 98 | !!$ REAL(wp), DIMENSION(:,:) :: firic ! IR flux over the ice (outputs only) |
|---|
| 99 | !!$ REAL(wp), DIMENSION(:,:) :: fcsic ! Sensible heat flux over the ice (outputs only) |
|---|
| 100 | !!$ REAL(wp), DIMENSION(:,:) :: fleic ! Latent heat flux over the ice (outputs only) |
|---|
| 101 | !!$ REAL(wp), DIMENSION(:,:) :: qlatic ! latent flux (outputs only) |
|---|
| 102 | REAL(wp), DIMENSION(jpi,jpj) :: zdvosif ! Variation of volume at surface (outputs only) |
|---|
| 103 | REAL(wp), DIMENSION(jpi,jpj) :: zdvobif ! Variation of ice volume at the bottom ice (outputs only) |
|---|
| 104 | REAL(wp), DIMENSION(jpi,jpj) :: zdvolif ! Total variation of ice volume (outputs only) |
|---|
| 105 | REAL(wp), DIMENSION(jpi,jpj) :: zdvonif ! Surface accretion Snow to Ice transformation (outputs only) |
|---|
| 106 | REAL(wp), DIMENSION(jpi,jpj) :: zdvomif ! Bottom variation of ice volume due to melting (outputs only) |
|---|
| 107 | REAL(wp), DIMENSION(jpi,jpj) :: zu_imasstr ! Sea-ice transport along i-axis at U-point (outputs only) |
|---|
| 108 | REAL(wp), DIMENSION(jpi,jpj) :: zv_imasstr ! Sea-ice transport along j-axis at V-point (outputs only) |
|---|
| 109 | REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! 3D workspace |
|---|
| 110 | !!------------------------------------------------------------------- |
|---|
| 111 | |
|---|
| 112 | |
|---|
| 113 | IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only) |
|---|
| 114 | |
|---|
| 115 | !-------------------------------------------! |
|---|
| 116 | ! Initilization of diagnostic variables ! |
|---|
| 117 | !-------------------------------------------! |
|---|
| 118 | |
|---|
| 119 | !!gm needed? yes at least for some of these arrays |
|---|
| 120 | zdvosif(:,:) = 0.e0 ! variation of ice volume at surface |
|---|
| 121 | zdvobif(:,:) = 0.e0 ! variation of ice volume at bottom |
|---|
| 122 | zdvolif(:,:) = 0.e0 ! total variation of ice volume |
|---|
| 123 | zdvonif(:,:) = 0.e0 ! transformation of snow to sea-ice volume |
|---|
| 124 | zlicegr(:,:) = 0.e0 ! lateral variation of ice volume |
|---|
| 125 | zdvomif(:,:) = 0.e0 ! variation of ice volume at bottom due to melting only |
|---|
| 126 | ztr_fram = 0.e0 ! sea-ice transport through Fram strait |
|---|
| 127 | fstric (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice |
|---|
| 128 | fscmbq (:,:) = 0.e0 ! linked with fstric |
|---|
| 129 | ffltbif(:,:) = 0.e0 ! linked with fstric |
|---|
| 130 | qfvbq (:,:) = 0.e0 ! linked with fstric |
|---|
| 131 | rdm_snw(:,:) = 0.e0 ! variation of snow mass over 1 time step |
|---|
| 132 | rdq_snw(:,:) = 0.e0 ! heat content associated with rdm_snw |
|---|
| 133 | rdm_ice(:,:) = 0.e0 ! variation of ice mass over 1 time step |
|---|
| 134 | rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice |
|---|
| 135 | zmsk (:,:,:) = 0.e0 |
|---|
| 136 | |
|---|
| 137 | ! set to zero snow thickness smaller than epsi04 |
|---|
| 138 | DO jj = 1, jpj |
|---|
| 139 | DO ji = 1, jpi |
|---|
| 140 | hsnif(ji,jj) = hsnif(ji,jj) * MAX( rzero, SIGN( rone , hsnif(ji,jj) - epsi04 ) ) |
|---|
| 141 | END DO |
|---|
| 142 | END DO |
|---|
| 143 | !!gm better coded (do not use SIGN...) |
|---|
| 144 | ! WHERE( hsnif(:,:) < epsi04 ) hsnif(:,:) = 0.e0 |
|---|
| 145 | !!gm |
|---|
| 146 | |
|---|
| 147 | IF(ln_ctl) CALL prt_ctl( tab2d_1=hsnif, clinfo1=' lim_thd: hsnif : ' ) |
|---|
| 148 | |
|---|
| 149 | !-----------------------------------! |
|---|
| 150 | ! Treatment of particular cases ! |
|---|
| 151 | !-----------------------------------! |
|---|
| 152 | |
|---|
| 153 | DO jj = 1, jpj |
|---|
| 154 | DO ji = 1, jpi |
|---|
| 155 | ! snow is transformed into ice if the original ice cover disappears. |
|---|
| 156 | zindg = tms(ji,jj) * MAX( rzero , SIGN( rone , -hicif(ji,jj) ) ) |
|---|
| 157 | hicif(ji,jj) = hicif(ji,jj) + zindg * rhosn * hsnif(ji,jj) / rau0 |
|---|
| 158 | hsnif(ji,jj) = ( rone - zindg ) * hsnif(ji,jj) + zindg * hicif(ji,jj) * ( rau0 - rhoic ) / rhosn |
|---|
| 159 | dmgwi(ji,jj) = zindg * (1.0 - frld(ji,jj)) * rhoic * hicif(ji,jj) ! snow/ice mass |
|---|
| 160 | |
|---|
| 161 | ! the lead fraction, frld, must be little than or equal to amax (ice ridging). |
|---|
| 162 | zthsnice = hsnif(ji,jj) + hicif(ji,jj) |
|---|
| 163 | zindb = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) |
|---|
| 164 | za = zindb * MIN( rone, ( 1.0 - frld(ji,jj) ) * uscomi ) |
|---|
| 165 | hsnif (ji,jj) = hsnif(ji,jj) * za |
|---|
| 166 | hicif (ji,jj) = hicif(ji,jj) * za |
|---|
| 167 | qstoif(ji,jj) = qstoif(ji,jj) * za |
|---|
| 168 | frld (ji,jj) = 1.0 - zindb * ( 1.0 - frld(ji,jj) ) / MAX( za, epsi20 ) |
|---|
| 169 | |
|---|
| 170 | ! the in situ ice thickness, hicif, must be equal to or greater than hiclim. |
|---|
| 171 | zh = MAX( rone , zindb * hiclim / MAX( hicif(ji,jj), epsi20 ) ) |
|---|
| 172 | hsnif (ji,jj) = hsnif(ji,jj) * zh |
|---|
| 173 | hicif (ji,jj) = hicif(ji,jj) * zh |
|---|
| 174 | qstoif(ji,jj) = qstoif(ji,jj) * zh |
|---|
| 175 | frld (ji,jj) = ( frld(ji,jj) + ( zh - 1.0 ) ) / zh |
|---|
| 176 | END DO |
|---|
| 177 | END DO |
|---|
| 178 | |
|---|
| 179 | IF(ln_ctl) THEN |
|---|
| 180 | CALL prt_ctl( tab2d_1=hicif , clinfo1=' lim_thd: hicif : ' ) |
|---|
| 181 | CALL prt_ctl( tab2d_1=hsnif , clinfo1=' lim_thd: hsnif : ' ) |
|---|
| 182 | CALL prt_ctl( tab2d_1=dmgwi , clinfo1=' lim_thd: dmgwi : ' ) |
|---|
| 183 | CALL prt_ctl( tab2d_1=qstoif, clinfo1=' lim_thd: qstoif : ' ) |
|---|
| 184 | CALL prt_ctl( tab2d_1=frld , clinfo1=' lim_thd: frld : ' ) |
|---|
| 185 | ENDIF |
|---|
| 186 | |
|---|
| 187 | |
|---|
| 188 | !-------------------------------! |
|---|
| 189 | ! Thermodynamics of sea ice ! |
|---|
| 190 | !-------------------------------! |
|---|
| 191 | |
|---|
| 192 | ! Partial computation of forcing for the thermodynamic sea ice model. |
|---|
| 193 | !-------------------------------------------------------------------------- |
|---|
| 194 | |
|---|
| 195 | DO jj = 1, jpj |
|---|
| 196 | DO ji = 1, jpi |
|---|
| 197 | zthsnice = hsnif(ji,jj) + hicif(ji,jj) |
|---|
| 198 | zindb = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) |
|---|
| 199 | pfrld(ji,jj) = frld(ji,jj) |
|---|
| 200 | zfricp = 1.0 - frld(ji,jj) |
|---|
| 201 | zinda = 1.0 - MAX( rzero , SIGN( rone , - zfricp ) ) |
|---|
| 202 | |
|---|
| 203 | ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget |
|---|
| 204 | thcm(ji,jj) = 0.e0 |
|---|
| 205 | |
|---|
| 206 | ! net downward heat flux from the ice to the ocean, expressed as a function of ocean |
|---|
| 207 | ! temperature and turbulent mixing (McPhee, 1992) |
|---|
| 208 | zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) ! friction velocity |
|---|
| 209 | fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_m(ji,jj) + rt0 - tfu(ji,jj) ) |
|---|
| 210 | qdtcn(ji,jj) = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice |
|---|
| 211 | |
|---|
| 212 | ! partial computation of the lead energy budget (qldif) |
|---|
| 213 | IF( ln_cpl ) THEN |
|---|
| 214 | qldif(ji,jj) = tms(ji,jj) * rdt_ice & |
|---|
| 215 | & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & |
|---|
| 216 | & + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp ) & |
|---|
| 217 | & + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) ) ) |
|---|
| 218 | ELSE |
|---|
| 219 | qldif(ji,jj) = tms(ji,jj) * rdt_ice * frld(ji,jj) & |
|---|
| 220 | & * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) ) & |
|---|
| 221 | & + qns(ji,jj) + fdtcn(ji,jj) & |
|---|
| 222 | & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) |
|---|
| 223 | ENDIF |
|---|
| 224 | ! parlat : percentage of energy used for lateral ablation (0.0) |
|---|
| 225 | zfntlat = 1.0 - MAX( rzero , SIGN( rone , - qldif(ji,jj) ) ) |
|---|
| 226 | zpareff = 1.0 + ( parlat - 1.0 ) * zinda * zfntlat |
|---|
| 227 | zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( (1.0 - frld(ji,jj)) * rdt_ice , epsi16 ) |
|---|
| 228 | qldif (ji,jj) = zpareff * qldif(ji,jj) |
|---|
| 229 | qdtcn (ji,jj) = zpareff * qdtcn(ji,jj) |
|---|
| 230 | |
|---|
| 231 | ! energy needed to bring ocean surface layer until its freezing |
|---|
| 232 | qcmif (ji,jj) = rau0 * rcp * e3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) |
|---|
| 233 | |
|---|
| 234 | ! calculate oceanic heat flux. |
|---|
| 235 | fbif (ji,jj) = zindb * ( fsbbq(ji,jj) / MAX( (1.0 - frld(ji,jj)) , epsi20 ) + fdtcn(ji,jj) ) |
|---|
| 236 | |
|---|
| 237 | ! computation of the thermodynamic ice production (only needed for output) |
|---|
| 238 | hicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) ) |
|---|
| 239 | END DO |
|---|
| 240 | END DO |
|---|
| 241 | |
|---|
| 242 | ! Select icy points and fulfill arrays for the vectorial grid. |
|---|
| 243 | !---------------------------------------------------------------------- |
|---|
| 244 | nbpb = 0 |
|---|
| 245 | DO jj = 1, jpj |
|---|
| 246 | DO ji = 1, jpi |
|---|
| 247 | IF ( frld(ji,jj) < 1.0 ) THEN |
|---|
| 248 | nbpb = nbpb + 1 |
|---|
| 249 | npb(nbpb) = (jj - 1) * jpi + ji |
|---|
| 250 | ENDIF |
|---|
| 251 | END DO |
|---|
| 252 | END DO |
|---|
| 253 | |
|---|
| 254 | IF(ln_ctl) THEN |
|---|
| 255 | CALL prt_ctl(tab2d_1=pfrld, clinfo1=' lim_thd: pfrld : ', tab2d_2=thcm , clinfo2=' thcm : ') |
|---|
| 256 | CALL prt_ctl(tab2d_1=fdtcn, clinfo1=' lim_thd: fdtcn : ', tab2d_2=qdtcn , clinfo2=' qdtcn : ') |
|---|
| 257 | CALL prt_ctl(tab2d_1=qldif, clinfo1=' lim_thd: qldif : ', tab2d_2=zqlbsbq, clinfo2=' zqlbsbq : ') |
|---|
| 258 | CALL prt_ctl(tab2d_1=qcmif, clinfo1=' lim_thd: qcmif : ', tab2d_2=fbif , clinfo2=' fbif : ') |
|---|
| 259 | zmsk(:,:,1) = tms(:,:) |
|---|
| 260 | CALL prt_ctl(tab2d_1=qcmif , clinfo1=' lim_thd: qcmif : ', mask1=zmsk) |
|---|
| 261 | CALL prt_ctl(tab2d_1=hicifp, clinfo1=' lim_thd: hicifp : ') |
|---|
| 262 | WRITE(charout, FMT="('lim_thd: nbpb = ',I4)") nbpb |
|---|
| 263 | CALL prt_ctl_info(charout) |
|---|
| 264 | ENDIF |
|---|
| 265 | |
|---|
| 266 | |
|---|
| 267 | ! If there is no ice, do nothing. Otherwise, compute Top and Bottom accretion/ablation |
|---|
| 268 | !------------------------------------------------------------------------------------ |
|---|
| 269 | |
|---|
| 270 | IF( nbpb > 0 ) THEN |
|---|
| 271 | ! |
|---|
| 272 | ! put the variable in a 1-D array for thermodynamics process |
|---|
| 273 | CALL tab_2d_1d_2( nbpb, frld_1d (1:nbpb) , frld , jpi, jpj, npb(1:nbpb) ) |
|---|
| 274 | CALL tab_2d_1d_2( nbpb, h_ice_1d (1:nbpb) , hicif , jpi, jpj, npb(1:nbpb) ) |
|---|
| 275 | CALL tab_2d_1d_2( nbpb, h_snow_1d (1:nbpb) , hsnif , jpi, jpj, npb(1:nbpb) ) |
|---|
| 276 | CALL tab_2d_1d_2( nbpb, sist_1d (1:nbpb) , sist , jpi, jpj, npb(1:nbpb) ) |
|---|
| 277 | CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 1 ), tbif(:,:,1) , jpi, jpj, npb(1:nbpb) ) |
|---|
| 278 | CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 2 ), tbif(:,:,2) , jpi, jpj, npb(1:nbpb) ) |
|---|
| 279 | CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 3 ), tbif(:,:,3) , jpi, jpj, npb(1:nbpb) ) |
|---|
| 280 | CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb) , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) ) |
|---|
| 281 | CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) |
|---|
| 282 | CALL tab_2d_1d_2( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) |
|---|
| 283 | CALL tab_2d_1d_2( nbpb, qns_ice_1d(1:nbpb) , qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) |
|---|
| 284 | CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb) , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) |
|---|
| 285 | IF( .NOT. ln_cpl ) THEN |
|---|
| 286 | CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) |
|---|
| 287 | CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb) , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) |
|---|
| 288 | ENDIF |
|---|
| 289 | CALL tab_2d_1d_2( nbpb, tfu_1d (1:nbpb) , tfu , jpi, jpj, npb(1:nbpb) ) |
|---|
| 290 | CALL tab_2d_1d_2( nbpb, sprecip_1d (1:nbpb) , sprecip , jpi, jpj, npb(1:nbpb) ) |
|---|
| 291 | CALL tab_2d_1d_2( nbpb, fbif_1d (1:nbpb) , fbif , jpi, jpj, npb(1:nbpb) ) |
|---|
| 292 | CALL tab_2d_1d_2( nbpb, thcm_1d (1:nbpb) , thcm , jpi, jpj, npb(1:nbpb) ) |
|---|
| 293 | CALL tab_2d_1d_2( nbpb, qldif_1d (1:nbpb) , qldif , jpi, jpj, npb(1:nbpb) ) |
|---|
| 294 | CALL tab_2d_1d_2( nbpb, qstbif_1d (1:nbpb) , qstoif , jpi, jpj, npb(1:nbpb) ) |
|---|
| 295 | CALL tab_2d_1d_2( nbpb, rdm_ice_1d (1:nbpb) , rdm_ice , jpi, jpj, npb(1:nbpb) ) |
|---|
| 296 | CALL tab_2d_1d_2( nbpb, rdq_ice_1d (1:nbpb) , rdq_ice , jpi, jpj, npb(1:nbpb) ) |
|---|
| 297 | CALL tab_2d_1d_2( nbpb, dmgwi_1d (1:nbpb) , dmgwi , jpi, jpj, npb(1:nbpb) ) |
|---|
| 298 | CALL tab_2d_1d_2( nbpb, rdm_snw_1d (1:nbpb) , rdm_snw , jpi, jpj, npb(1:nbpb) ) |
|---|
| 299 | CALL tab_2d_1d_2( nbpb, rdq_snw_1d (1:nbpb) , rdq_snw , jpi, jpj, npb(1:nbpb) ) |
|---|
| 300 | CALL tab_2d_1d_2( nbpb, qlbbq_1d (1:nbpb) , zqlbsbq , jpi, jpj, npb(1:nbpb) ) |
|---|
| 301 | ! |
|---|
| 302 | CALL lim_thd_zdf_2( 1, nbpb ) ! compute ice growth |
|---|
| 303 | ! |
|---|
| 304 | ! back to the geographic grid. |
|---|
| 305 | CALL tab_1d_2d_2( nbpb, frld , npb, frld_1d (1:nbpb) , jpi, jpj ) |
|---|
| 306 | CALL tab_1d_2d_2( nbpb, hicif , npb, h_ice_1d (1:nbpb) , jpi, jpj ) |
|---|
| 307 | CALL tab_1d_2d_2( nbpb, hsnif , npb, h_snow_1d (1:nbpb) , jpi, jpj ) |
|---|
| 308 | CALL tab_1d_2d_2( nbpb, sist , npb, sist_1d (1:nbpb) , jpi, jpj ) |
|---|
| 309 | CALL tab_1d_2d_2( nbpb, tbif(:,:,1), npb, tbif_1d (1:nbpb , 1 ), jpi, jpj ) |
|---|
| 310 | CALL tab_1d_2d_2( nbpb, tbif(:,:,2), npb, tbif_1d (1:nbpb , 2 ), jpi, jpj ) |
|---|
| 311 | CALL tab_1d_2d_2( nbpb, tbif(:,:,3), npb, tbif_1d (1:nbpb , 3 ), jpi, jpj ) |
|---|
| 312 | CALL tab_1d_2d_2( nbpb, fscmbq , npb, fscbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 313 | CALL tab_1d_2d_2( nbpb, ffltbif , npb, fltbif_1d (1:nbpb) , jpi, jpj ) |
|---|
| 314 | CALL tab_1d_2d_2( nbpb, fstric , npb, fstbif_1d (1:nbpb) , jpi, jpj ) |
|---|
| 315 | CALL tab_1d_2d_2( nbpb, qldif , npb, qldif_1d (1:nbpb) , jpi, jpj ) |
|---|
| 316 | CALL tab_1d_2d_2( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 317 | CALL tab_1d_2d_2( nbpb, qstoif , npb, qstbif_1d (1:nbpb) , jpi, jpj ) |
|---|
| 318 | CALL tab_1d_2d_2( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) |
|---|
| 319 | CALL tab_1d_2d_2( nbpb, rdq_ice , npb, rdq_ice_1d(1:nbpb) , jpi, jpj ) |
|---|
| 320 | CALL tab_1d_2d_2( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) |
|---|
| 321 | CALL tab_1d_2d_2( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) |
|---|
| 322 | CALL tab_1d_2d_2( nbpb, rdq_snw , npb, rdq_snw_1d(1:nbpb) , jpi, jpj ) |
|---|
| 323 | CALL tab_1d_2d_2( nbpb, zdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 324 | CALL tab_1d_2d_2( nbpb, zdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 325 | CALL tab_1d_2d_2( nbpb, zdvomif , npb, rdvomif_1d(1:nbpb) , jpi, jpj ) |
|---|
| 326 | CALL tab_1d_2d_2( nbpb, zdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 327 | CALL tab_1d_2d_2( nbpb, zdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) |
|---|
| 328 | CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) |
|---|
| 329 | CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) |
|---|
| 330 | IF( .NOT. ln_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) |
|---|
| 331 | ! |
|---|
| 332 | ENDIF |
|---|
| 333 | |
|---|
| 334 | ! Up-date sea ice thickness |
|---|
| 335 | !-------------------------- |
|---|
| 336 | DO jj = 1, jpj |
|---|
| 337 | DO ji = 1, jpi |
|---|
| 338 | phicif(ji,jj) = hicif(ji,jj) |
|---|
| 339 | hicif(ji,jj) = hicif(ji,jj) * ( rone - MAX( rzero, SIGN( rone, - ( 1.0 - frld(ji,jj) ) ) ) ) |
|---|
| 340 | END DO |
|---|
| 341 | END DO |
|---|
| 342 | |
|---|
| 343 | |
|---|
| 344 | ! Tricky trick : add 2 to frld in the Southern Hemisphere |
|---|
| 345 | !-------------------------------------------------------- |
|---|
| 346 | IF( ff_t(1,1) < 0._wp ) THEN |
|---|
| 347 | DO jj = 1, njeqm1 |
|---|
| 348 | DO ji = 1, jpi |
|---|
| 349 | frld(ji,jj) = frld(ji,jj) + 2.0 |
|---|
| 350 | END DO |
|---|
| 351 | END DO |
|---|
| 352 | ENDIF |
|---|
| 353 | |
|---|
| 354 | CALL lbc_lnk( frld , 'T', 1. ) |
|---|
| 355 | |
|---|
| 356 | ! Select points for lateral accretion (this occurs when heat exchange |
|---|
| 357 | ! between ice and ocean is negative; ocean losing heat) |
|---|
| 358 | !----------------------------------------------------------------- |
|---|
| 359 | nbpac = 0 |
|---|
| 360 | DO jj = 1, jpj |
|---|
| 361 | DO ji = 1, jpi |
|---|
| 362 | !i yes! IF ( ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN |
|---|
| 363 | IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN |
|---|
| 364 | nbpac = nbpac + 1 |
|---|
| 365 | npac( nbpac ) = (jj - 1) * jpi + ji |
|---|
| 366 | ENDIF |
|---|
| 367 | END DO |
|---|
| 368 | END DO |
|---|
| 369 | |
|---|
| 370 | IF(ln_ctl) THEN |
|---|
| 371 | CALL prt_ctl(tab2d_1=phicif, clinfo1=' lim_thd: phicif : ', tab2d_2=hicif, clinfo2=' hicif : ') |
|---|
| 372 | WRITE(charout, FMT="('lim_thd: nbpac = ',I4)") nbpac |
|---|
| 373 | CALL prt_ctl_info(charout) |
|---|
| 374 | ENDIF |
|---|
| 375 | |
|---|
| 376 | |
|---|
| 377 | ! If ocean gains heat do nothing ; otherwise, one performs lateral accretion |
|---|
| 378 | !-------------------------------------------------------------------------------- |
|---|
| 379 | IF( nbpac > 0 ) THEN |
|---|
| 380 | ! |
|---|
| 381 | zlicegr(:,:) = rdm_ice(:,:) ! to output the lateral sea-ice growth |
|---|
| 382 | !...Put the variable in a 1-D array for lateral accretion |
|---|
| 383 | CALL tab_2d_1d_2( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) ) |
|---|
| 384 | CALL tab_2d_1d_2( nbpac, h_snow_1d (1:nbpac) , hsnif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 385 | CALL tab_2d_1d_2( nbpac, h_ice_1d (1:nbpac) , hicif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 386 | CALL tab_2d_1d_2( nbpac, tbif_1d (1:nbpac , 1 ), tbif(:,:,1), jpi, jpj, npac(1:nbpac) ) |
|---|
| 387 | CALL tab_2d_1d_2( nbpac, tbif_1d (1:nbpac , 2 ), tbif(:,:,2), jpi, jpj, npac(1:nbpac) ) |
|---|
| 388 | CALL tab_2d_1d_2( nbpac, tbif_1d (1:nbpac , 3 ), tbif(:,:,3), jpi, jpj, npac(1:nbpac) ) |
|---|
| 389 | CALL tab_2d_1d_2( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 390 | CALL tab_2d_1d_2( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 391 | CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 392 | CALL tab_2d_1d_2( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice , jpi, jpj, npac(1:nbpac) ) |
|---|
| 393 | CALL tab_2d_1d_2( nbpac, rdq_ice_1d(1:nbpac) , rdq_ice , jpi, jpj, npac(1:nbpac) ) |
|---|
| 394 | CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , zdvolif , jpi, jpj, npac(1:nbpac) ) |
|---|
| 395 | CALL tab_2d_1d_2( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) ) |
|---|
| 396 | ! |
|---|
| 397 | CALL lim_thd_lac_2( 1 , nbpac ) ! lateral accretion routine. |
|---|
| 398 | ! |
|---|
| 399 | ! back to the geographic grid |
|---|
| 400 | CALL tab_1d_2d_2( nbpac, frld , npac(1:nbpac), frld_1d (1:nbpac) , jpi, jpj ) |
|---|
| 401 | CALL tab_1d_2d_2( nbpac, hsnif , npac(1:nbpac), h_snow_1d (1:nbpac) , jpi, jpj ) |
|---|
| 402 | CALL tab_1d_2d_2( nbpac, hicif , npac(1:nbpac), h_ice_1d (1:nbpac) , jpi, jpj ) |
|---|
| 403 | CALL tab_1d_2d_2( nbpac, tbif(:,:,1), npac(1:nbpac), tbif_1d (1:nbpac , 1 ), jpi, jpj ) |
|---|
| 404 | CALL tab_1d_2d_2( nbpac, tbif(:,:,2), npac(1:nbpac), tbif_1d (1:nbpac , 2 ), jpi, jpj ) |
|---|
| 405 | CALL tab_1d_2d_2( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d (1:nbpac , 3 ), jpi, jpj ) |
|---|
| 406 | CALL tab_1d_2d_2( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) |
|---|
| 407 | CALL tab_1d_2d_2( nbpac, rdm_ice , npac(1:nbpac), rdm_ice_1d(1:nbpac) , jpi, jpj ) |
|---|
| 408 | CALL tab_1d_2d_2( nbpac, rdq_ice , npac(1:nbpac), rdq_ice_1d(1:nbpac) , jpi, jpj ) |
|---|
| 409 | CALL tab_1d_2d_2( nbpac, zdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) |
|---|
| 410 | ! |
|---|
| 411 | ENDIF |
|---|
| 412 | |
|---|
| 413 | |
|---|
| 414 | ! Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick) |
|---|
| 415 | ! Update daily thermodynamic ice production. |
|---|
| 416 | !------------------------------------------------------------------------------ |
|---|
| 417 | DO jj = 1, jpj |
|---|
| 418 | DO ji = 1, jpi |
|---|
| 419 | frld (ji,jj) = MIN( frld(ji,jj), ABS( frld(ji,jj) - 2.0 ) ) |
|---|
| 420 | fr_i (ji,jj) = 1.0 - frld(ji,jj) |
|---|
| 421 | hicifp(ji,jj) = hicif(ji,jj) * fr_i(ji,jj) - hicifp(ji,jj) |
|---|
| 422 | END DO |
|---|
| 423 | END DO |
|---|
| 424 | |
|---|
| 425 | ! Outputs |
|---|
| 426 | !-------------------------------------------------------------------------------- |
|---|
| 427 | ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic |
|---|
| 428 | IF( iom_use('ist_cea' ) ) CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] |
|---|
| 429 | IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] |
|---|
| 430 | IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] |
|---|
| 431 | IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & |
|---|
| 432 | & CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] |
|---|
| 433 | ! |
|---|
| 434 | IF( iom_use('snowthic_cea')) CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] |
|---|
| 435 | IF( iom_use('icethic_cea' )) CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] |
|---|
| 436 | zztmp = 1.0 / rdt_ice |
|---|
| 437 | IF( iom_use('iceprod_cea') ) CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] |
|---|
| 438 | IF( iom_use('iiceconc' ) ) CALL iom_put( 'iiceconc' , fr_i(:,:) ) ! Ice concentration [-] |
|---|
| 439 | IF( iom_use('snowmel_cea') ) CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] |
|---|
| 440 | zztmp = rhoic / rdt_ice |
|---|
| 441 | IF( iom_use('sntoice_cea') ) CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] |
|---|
| 442 | IF( iom_use('ticemel_cea') ) CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] |
|---|
| 443 | IF( iom_use('bicemel_cea') ) CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] |
|---|
| 444 | IF( iom_use('licepro_cea') ) THEN |
|---|
| 445 | zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) |
|---|
| 446 | CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth [kg/m2/s] |
|---|
| 447 | ENDIF |
|---|
| 448 | ! |
|---|
| 449 | ! Compute the Eastward & Northward sea-ice transport |
|---|
| 450 | IF( iom_use('u_imasstr') ) THEN |
|---|
| 451 | zztmp = 0.25 * rhoic |
|---|
| 452 | DO jj = 1, jpjm1 |
|---|
| 453 | DO ji = 1, jpim1 ! NO vector opt. |
|---|
| 454 | ! Ice velocities, volume & transport at U-points |
|---|
| 455 | zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) |
|---|
| 456 | zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj )*e2t(ji+1,jj )*fr_i(ji+1,jj ) |
|---|
| 457 | zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m |
|---|
| 458 | END DO |
|---|
| 459 | END DO |
|---|
| 460 | CALL lbc_lnk( zu_imasstr, 'U', -1. ) |
|---|
| 461 | CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] |
|---|
| 462 | ENDIF |
|---|
| 463 | IF( iom_use('v_imasstr') ) THEN |
|---|
| 464 | zztmp = 0.25 * rhoic |
|---|
| 465 | DO jj = 1, jpjm1 |
|---|
| 466 | DO ji = 1, jpim1 ! NO vector opt. |
|---|
| 467 | ! Ice velocities, volume & transport at V-points |
|---|
| 468 | zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) |
|---|
| 469 | zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji ,jj+1)*e1t(ji ,jj+1)*fr_i(ji ,jj+1) |
|---|
| 470 | zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m |
|---|
| 471 | END DO |
|---|
| 472 | END DO |
|---|
| 473 | CALL lbc_lnk( zv_imasstr, 'V', -1. ) |
|---|
| 474 | CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] |
|---|
| 475 | ENDIF |
|---|
| 476 | |
|---|
| 477 | !! Fram Strait sea-ice transport (sea-ice + snow) (in ORCA2 = 5 points) |
|---|
| 478 | IF( iom_use('fram_trans') .and. cn_cfg == "orca" .AND. nn_cfg == 2 ) THEN ! ORCA R2 configuration |
|---|
| 479 | DO jj = mj0(137), mj1(137) ! B grid |
|---|
| 480 | IF( mj0(jj-1) >= nldj ) THEN |
|---|
| 481 | DO ji = MAX(mi0(134),nldi), MIN(mi1(138),nlei) |
|---|
| 482 | zrhoij = e1t(ji,jj ) * fr_i(ji,jj ) * ( rhoic*hicif(ji,jj ) + rhosn*hsnif(ji,jj ) ) |
|---|
| 483 | zrhoijm1 = e1t(ji,jj-1) * fr_i(ji,jj-1) * ( rhoic*hicif(ji,jj-1) + rhosn*hsnif(ji,jj-1) ) |
|---|
| 484 | ztr_fram = ztr_fram - 0.25 * ( v_ice(ji,jj)+ v_ice(ji+1,jj) ) * ( zrhoij + zrhoijm1 ) |
|---|
| 485 | END DO |
|---|
| 486 | ENDIF |
|---|
| 487 | END DO |
|---|
| 488 | IF( lk_mpp ) CALL mpp_sum( ztr_fram ) |
|---|
| 489 | CALL iom_put( 'fram_trans', ztr_fram ) ! Ice transport through Fram strait [kg/s] |
|---|
| 490 | ENDIF |
|---|
| 491 | |
|---|
| 492 | IF( iom_use('ice_pres') .OR. iom_use('ist_ipa') .OR. iom_use('uice_ipa') .OR. iom_use('vice_ipa') ) THEN |
|---|
| 493 | !! ce ztmp(:,:) = 1. - AINT( frld(:,:), wp ) ! return 1 as soon as there is ice |
|---|
| 494 | !! ce A big warning because the model crashes on IDRIS/IBM SP6 with xlf 13.1.0.3, see ticket #761 |
|---|
| 495 | !! ce We Unroll the loop and everything works fine |
|---|
| 496 | DO jj = 1, jpj |
|---|
| 497 | DO ji = 1, jpi |
|---|
| 498 | ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp ) ! return 1 as soon as there is ice |
|---|
| 499 | END DO |
|---|
| 500 | END DO |
|---|
| 501 | ! |
|---|
| 502 | IF( iom_use('ice_pres') ) CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] |
|---|
| 503 | IF( iom_use('ist_ipa' ) ) CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] |
|---|
| 504 | IF( iom_use('uice_ipa') ) CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] |
|---|
| 505 | IF( iom_use('vice_ipa') ) CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] |
|---|
| 506 | ENDIF |
|---|
| 507 | |
|---|
| 508 | IF(ln_ctl) THEN |
|---|
| 509 | CALL prt_ctl_info(' lim_thd end ') |
|---|
| 510 | CALL prt_ctl( tab2d_1=hicif , clinfo1=' lim_thd: hicif : ', tab2d_2=hsnif , clinfo2=' hsnif : ' ) |
|---|
| 511 | CALL prt_ctl( tab2d_1=frld , clinfo1=' lim_thd: frld : ', tab2d_2=hicifp, clinfo2=' hicifp : ' ) |
|---|
| 512 | CALL prt_ctl( tab2d_1=phicif , clinfo1=' lim_thd: phicif : ', tab2d_2=pfrld , clinfo2=' pfrld : ' ) |
|---|
| 513 | CALL prt_ctl( tab2d_1=sist , clinfo1=' lim_thd: sist : ' ) |
|---|
| 514 | CALL prt_ctl( tab2d_1=tbif(:,:,1), clinfo1=' lim_thd: tbif 1 : ' ) |
|---|
| 515 | CALL prt_ctl( tab2d_1=tbif(:,:,2), clinfo1=' lim_thd: tbif 2 : ' ) |
|---|
| 516 | CALL prt_ctl( tab2d_1=tbif(:,:,3), clinfo1=' lim_thd: tbif 3 : ' ) |
|---|
| 517 | CALL prt_ctl( tab2d_1=fdtcn , clinfo1=' lim_thd: fdtcn : ', tab2d_2=qdtcn , clinfo2=' qdtcn : ' ) |
|---|
| 518 | CALL prt_ctl( tab2d_1=qstoif , clinfo1=' lim_thd: qstoif : ', tab2d_2=fsbbq , clinfo2=' fsbbq : ' ) |
|---|
| 519 | ENDIF |
|---|
| 520 | ! |
|---|
| 521 | ! |
|---|
| 522 | END SUBROUTINE lim_thd_2 |
|---|
| 523 | |
|---|
| 524 | |
|---|
| 525 | SUBROUTINE lim_thd_init_2 |
|---|
| 526 | !!------------------------------------------------------------------- |
|---|
| 527 | !! *** ROUTINE lim_thd_init_2 *** |
|---|
| 528 | !! |
|---|
| 529 | !! ** Purpose : Physical constants and parameters linked to the ice |
|---|
| 530 | !! thermodynamics |
|---|
| 531 | !! |
|---|
| 532 | !! ** Method : Read the namicethd namelist and check the ice-thermo |
|---|
| 533 | !! parameter values called at the first timestep (nit000) |
|---|
| 534 | !! |
|---|
| 535 | !! ** input : Namelist namicether |
|---|
| 536 | !!------------------------------------------------------------------- |
|---|
| 537 | INTEGER :: ios ! Local integer output status for namelist read |
|---|
| 538 | NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax , & |
|---|
| 539 | & swiqst, sbeta , parlat, hakspl, hibspl, exld, & |
|---|
| 540 | & hakdif, hnzst , thth , parsub, alphs |
|---|
| 541 | !!------------------------------------------------------------------- |
|---|
| 542 | |
|---|
| 543 | REWIND( numnam_ice_ref ) ! Namelist namicethd in reference namelist : Ice thermodynamics |
|---|
| 544 | READ ( numnam_ice_ref, namicethd, IOSTAT = ios, ERR = 901) |
|---|
| 545 | 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in reference namelist', lwp ) |
|---|
| 546 | |
|---|
| 547 | REWIND( numnam_ice_cfg ) ! Namelist namicethd in configuration namelist : Ice thermodynamics |
|---|
| 548 | READ ( numnam_ice_cfg, namicethd, IOSTAT = ios, ERR = 902 ) |
|---|
| 549 | 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) |
|---|
| 550 | IF(lwm) WRITE ( numoni, namicethd ) |
|---|
| 551 | |
|---|
| 552 | IF( ln_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) |
|---|
| 553 | ! |
|---|
| 554 | IF(lwp) THEN ! control print |
|---|
| 555 | WRITE(numout,*) |
|---|
| 556 | WRITE(numout,*)'lim_thd_init_2: ice parameters for ice thermodynamic computation ' |
|---|
| 557 | WRITE(numout,*)'~~~~~~~~~~~~~~' |
|---|
| 558 | WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt |
|---|
| 559 | WRITE(numout,*)' ice thick. for lateral accretion in NH (SH) hiccrit(1/2) = ', hiccrit |
|---|
| 560 | WRITE(numout,*)' ice thick. corr. to max. energy stored in brine pocket hicmin = ', hicmin |
|---|
| 561 | WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim |
|---|
| 562 | WRITE(numout,*)' maximum lead fraction amax = ', amax |
|---|
| 563 | WRITE(numout,*)' energy stored in brine pocket (=1) or not (=0) swiqst = ', swiqst |
|---|
| 564 | WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' |
|---|
| 565 | WRITE(numout,*)' Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) sbeta = ', sbeta |
|---|
| 566 | WRITE(numout,*)' percentage of energy used for lateral ablation parlat = ', parlat |
|---|
| 567 | WRITE(numout,*)' slope of distr. for Hakkinen-Mellor lateral melting hakspl = ', hakspl |
|---|
| 568 | WRITE(numout,*)' slope of distribution for Hibler lateral melting hibspl = ', hibspl |
|---|
| 569 | WRITE(numout,*)' exponent for leads-closure rate exld = ', exld |
|---|
| 570 | WRITE(numout,*)' coefficient for diffusions of ice and snow hakdif = ', hakdif |
|---|
| 571 | WRITE(numout,*)' threshold thick. for comp. of eq. thermal conductivity zhth = ', thth |
|---|
| 572 | WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst |
|---|
| 573 | WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub |
|---|
| 574 | WRITE(numout,*)' coefficient for snow density when snow ice formation alphs = ', alphs |
|---|
| 575 | ENDIF |
|---|
| 576 | ! |
|---|
| 577 | uscomi = 1.0 / ( 1.0 - amax ) ! inverse of minimum lead fraction |
|---|
| 578 | rcdsn = hakdif * rcdsn |
|---|
| 579 | rcdic = hakdif * rcdic |
|---|
| 580 | ! |
|---|
| 581 | IF( hsndif > 100.e0 .OR. hicdif > 100.e0 ) THEN |
|---|
| 582 | cnscg = 0.e0 |
|---|
| 583 | ELSE |
|---|
| 584 | cnscg = rcpsn / rcpic ! ratio rcpsn/rcpic |
|---|
| 585 | ENDIF |
|---|
| 586 | ! |
|---|
| 587 | END SUBROUTINE lim_thd_init_2 |
|---|
| 588 | |
|---|
| 589 | #else |
|---|
| 590 | !!---------------------------------------------------------------------- |
|---|
| 591 | !! Default option Dummy module NO LIM 2.0 sea-ice model |
|---|
| 592 | !!---------------------------------------------------------------------- |
|---|
| 593 | CONTAINS |
|---|
| 594 | SUBROUTINE lim_thd_2 ! Dummy routine |
|---|
| 595 | END SUBROUTINE lim_thd_2 |
|---|
| 596 | #endif |
|---|
| 597 | |
|---|
| 598 | !!====================================================================== |
|---|
| 599 | END MODULE limthd_2 |
|---|
