Changeset 11518 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/iceistate.F90
- Timestamp:
- 2019-09-09T19:57:45+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/iceistate.F90
r11402 r11518 101 101 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays 102 102 !! 103 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d 103 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 104 104 !-------------------------------------------------------------------- 105 105 … … 209 209 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 210 210 ! 211 ! pond s211 ! pond concentration 212 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) 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) 214 215 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 216 ! 217 ! pond depth 215 218 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 216 219 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) … … 238 241 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 239 242 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 240 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) 243 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 241 244 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 242 245 ELSEWHERE … … 248 251 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 249 252 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 250 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) 253 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 251 254 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 252 255 END WHERE 253 256 ! 254 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 263 ENDIF 264 255 265 !-------------! 256 266 ! fill fields ! … … 275 285 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 276 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 ) 277 289 278 290 ! allocate temporary arrays 279 291 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 280 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_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) ) 281 293 282 294 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 283 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), zhi_2d, zhs_2d, zai_2d , & 284 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), zti_2d, zts_2d, ztsu_2d, zsi_2d ) 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 ) 285 299 286 300 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) … … 289 303 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 290 304 END DO 291 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 292 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 293 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 294 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 295 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 296 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 297 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 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 ) 298 314 299 315 ! deallocate temporary arrays 300 316 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 301 & zti_2d, zts_2d, ztsu_2d, zsi_2d ) 302 303 ! Melt ponds: distribute uniformely over the categories 304 IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN 305 DO jl = 1, jpl 306 a_ip_frac(:,:,jl) = zapnd_ini(:,:) 307 h_ip (:,:,jl) = zhpnd_ini(:,:) 308 a_ip (:,:,jl) = a_ip_frac(:,:,jl) * a_i (:,:,jl) 309 v_ip (:,:,jl) = h_ip (:,:,jl) * a_ip(:,:,jl) 310 END DO 311 ENDIF 312 317 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 318 313 319 ! calculate extensive and intensive variables 314 320 CALL ice_var_salprof ! for sz_i … … 350 356 END DO 351 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 352 366 ! specific temperatures for coupled runs 353 367 tn_ice(:,:,:) = t_su(:,:,:) … … 512 526 ENDIF 513 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' ) 532 ENDIF 533 ! 514 534 END SUBROUTINE ice_istate_init 515 535
Note: See TracChangeset
for help on using the changeset viewer.
