- Timestamp:
- 2020-07-02T17:33:41+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/iceistate.F90
r12939 r13229 32 32 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 33 33 USE fldread ! read input fields 34 35 # if defined key_agrif 36 USE agrif_oce 37 USE agrif_ice 38 USE agrif_ice_interp 39 # endif 34 40 35 41 IMPLICIT NONE … … 168 174 ! 2) overwrite some of the fields with namelist parameters or netcdf file 169 175 !------------------------------------------------------------------------ 176 177 170 178 IF( ln_iceini ) THEN 171 179 ! !---------------! 172 IF( ln_iceini_file )THEN ! Read a file ! 173 ! !---------------! 174 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 175 ELSEWHERE ; zswitch(:,:) = 0._wp 180 181 IF( Agrif_Root() ) THEN 182 183 IF( ln_iceini_file )THEN ! Read a file ! 184 ! !---------------! 185 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 186 ELSEWHERE ; zswitch(:,:) = 0._wp 187 END WHERE 188 ! 189 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 190 ! 191 ! -- mandatory fields -- ! 192 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 193 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 194 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 195 196 ! -- optional fields -- ! 197 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 198 ! 199 ! ice salinity 200 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 201 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 202 ! 203 ! temperatures 204 IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 205 & TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 206 si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 207 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 208 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 209 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 210 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 211 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 212 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 213 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 214 si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 215 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 216 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 217 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 218 si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 219 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 220 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 221 ENDIF 222 ! 223 ! pond concentration 224 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 225 & 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. 226 & * si(jp_ati)%fnow(:,:,1) 227 ! 228 ! pond depth 229 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 230 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 231 ! 232 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 233 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 234 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 235 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 236 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 237 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 238 ! 239 ! change the switch for the following 240 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 241 ELSEWHERE ; zswitch(:,:) = 0._wp 242 END WHERE 243 244 ! !---------------! 245 ELSE ! Read namelist ! 246 ! !---------------! 247 ! no ice if (sst - Tfreez) >= thresold 248 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 249 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 250 END WHERE 251 ! 252 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 253 WHERE( ff_t(:,:) >= 0._wp ) 254 zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 255 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 256 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 257 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 258 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 259 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 260 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 261 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 262 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 263 ELSEWHERE 264 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 265 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 266 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 267 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 268 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 269 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 270 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 271 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 272 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 273 END WHERE 274 ! 275 ENDIF 276 277 278 279 ! make sure ponds = 0 if no ponds scheme 280 IF ( .NOT.ln_pnd ) THEN 281 zapnd_ini(:,:) = 0._wp 282 zhpnd_ini(:,:) = 0._wp 283 ENDIF 284 285 !-------------! 286 ! fill fields ! 287 !-------------! 288 ! select ice covered grid points 289 npti = 0 ; nptidx(:) = 0 290 DO_2D_11_11 291 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 292 npti = npti + 1 293 nptidx(npti) = (jj - 1) * jpi + ji 294 ENDIF 295 END_2D 296 297 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 298 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 299 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 300 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 301 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 302 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 303 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 304 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 305 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 306 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 307 308 ! allocate temporary arrays 309 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 310 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 311 312 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 313 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 314 & zhi_2d , zhs_2d , zai_2d , & 315 & 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), & 316 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 317 318 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 319 DO jl = 1, jpl 320 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 321 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 322 END DO 323 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 324 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 325 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 326 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 327 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 328 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 329 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 330 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 331 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 332 333 ! deallocate temporary arrays 334 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 335 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 336 337 ! calculate extensive and intensive variables 338 CALL ice_var_salprof ! for sz_i 339 DO jl = 1, jpl 340 DO_2D_11_11 341 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 342 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 343 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 344 END_2D 345 END DO 346 ! 347 DO jl = 1, jpl 348 DO_3D_11_11( 1, nlay_s ) 349 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 350 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 351 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 352 END_3D 353 END DO 354 ! 355 DO jl = 1, jpl 356 DO_3D_11_11( 1, nlay_i ) 357 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 358 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 359 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 360 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 361 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 362 & - rcp * ( ztmelts - rt0 ) ) 363 END_3D 364 END DO 365 366 ! Melt ponds 367 WHERE( a_i > epsi10 ) 368 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 369 ELSEWHERE 370 a_ip_frac(:,:,:) = 0._wp 176 371 END WHERE 372 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 373 374 ! specific temperatures for coupled runs 375 tn_ice(:,:,:) = t_su(:,:,:) 376 t1_ice(:,:,:) = t_i (:,:,1,:) 177 377 ! 178 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 179 ! 180 ! -- mandatory fields -- ! 181 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 182 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 183 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 184 185 ! -- optional fields -- ! 186 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 187 ! 188 ! ice salinity 189 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 190 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 191 ! 192 ! temperatures 193 IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 194 & TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 195 si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 196 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 197 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 198 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 199 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 200 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 201 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 202 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 203 si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 204 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 205 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 206 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 207 si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 208 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 209 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 210 ENDIF 211 ! 212 ! pond concentration 213 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 214 & 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. 215 & * si(jp_ati)%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 ! 221 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 222 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 223 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 224 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 225 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 226 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 227 ! 228 ! change the switch for the following 229 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 230 ELSEWHERE ; zswitch(:,:) = 0._wp 378 379 #if defined key_agrif 380 ELSE 381 382 Agrif_SpecialValue = -9999. 383 Agrif_UseSpecialValue = .TRUE. 384 CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 385 use_sign_north = .TRUE. 386 sign_north = -1. 387 CALL Agrif_init_variable(u_iceini_id ,procname=interp_u_ice) 388 CALL Agrif_init_variable(v_iceini_id ,procname=interp_v_ice) 389 Agrif_SpecialValue = 0._wp 390 use_sign_north = .FALSE. 391 Agrif_UseSpecialValue = .FALSE. 392 ! lbc ???? 393 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i 394 CALL ice_var_glo2eqv 395 CALL ice_var_zapsmall 396 CALL ice_var_agg(2) 397 398 ! Melt ponds 399 WHERE( a_i > epsi10 ) 400 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 401 ELSEWHERE 402 a_ip_frac(:,:,:) = 0._wp 231 403 END WHERE 232 ! !---------------! 233 ELSE ! Read namelist ! 234 ! !---------------! 235 ! no ice if (sst - Tfreez) >= thresold 236 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 237 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 238 END WHERE 239 ! 240 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 241 WHERE( ff_t(:,:) >= 0._wp ) 242 zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 243 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 244 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 245 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 246 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 247 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 248 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 249 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 250 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 404 WHERE( a_ip > 0._wp ) ! ??????? 405 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 251 406 ELSEWHERE 252 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 253 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 254 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 255 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 256 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 257 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 258 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 259 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 260 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 261 END WHERE 262 ! 263 ENDIF 264 265 ! make sure ponds = 0 if no ponds scheme 266 IF ( .NOT.ln_pnd ) THEN 267 zapnd_ini(:,:) = 0._wp 268 zhpnd_ini(:,:) = 0._wp 269 ENDIF 270 271 !-------------! 272 ! fill fields ! 273 !-------------! 274 ! select ice covered grid points 275 npti = 0 ; nptidx(:) = 0 276 DO_2D_11_11 277 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 278 npti = npti + 1 279 nptidx(npti) = (jj - 1) * jpi + ji 280 ENDIF 281 END_2D 282 283 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 284 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 285 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 286 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 287 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 288 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 289 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 290 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 291 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 292 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 293 294 ! allocate temporary arrays 295 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 296 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 297 298 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 299 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 300 & zhi_2d , zhs_2d , zai_2d , & 301 & 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), & 302 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 303 304 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 305 DO jl = 1, jpl 306 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 307 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 308 END DO 309 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 310 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 311 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 312 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 313 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 314 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 315 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 316 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 317 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 318 319 ! deallocate temporary arrays 320 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 321 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 322 323 ! calculate extensive and intensive variables 324 CALL ice_var_salprof ! for sz_i 325 DO jl = 1, jpl 326 DO_2D_11_11 327 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 328 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 329 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 330 END_2D 331 END DO 332 ! 333 DO jl = 1, jpl 334 DO_3D_11_11( 1, 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 ) 338 END_3D 339 END DO 340 ! 341 DO jl = 1, jpl 342 DO_3D_11_11( 1, nlay_i ) 343 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 344 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 345 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 346 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 347 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 348 & - rcp * ( ztmelts - rt0 ) ) 349 END_3D 350 END DO 351 352 ! Melt ponds 353 WHERE( a_i > epsi10 ) 354 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 355 ELSEWHERE 356 a_ip_frac(:,:,:) = 0._wp 357 END WHERE 358 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 359 360 ! specific temperatures for coupled runs 361 tn_ice(:,:,:) = t_su(:,:,:) 362 t1_ice(:,:,:) = t_i (:,:,1,:) 363 ! 407 h_ip(:,:,:) = 0._wp 408 END WHERE 409 410 tn_ice(:,:,:) = t_su(:,:,:) 411 t1_ice(:,:,:) = t_i (:,:,1,:) 412 #endif 413 ENDIF ! Agrif_Root 364 414 ENDIF ! ln_iceini 365 415 !
Note: See TracChangeset
for help on using the changeset viewer.
