- Timestamp:
- 2019-09-09T19:57:45+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE
- Files:
-
- 5 edited
-
ice.F90 (modified) (4 diffs)
-
iceistate.F90 (modified) (8 diffs)
-
icethd_pnd.F90 (modified) (2 diffs)
-
icevar.F90 (modified) (13 diffs)
-
icewri.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/ice.F90
r11511 r11518 110 110 !! bv_i | - | relative brine volume | ??? | 111 111 !! at_ip | - | Total ice pond concentration | | 112 !! hm_ip | - | Mean ice pond depth | m | 112 113 !! vt_ip | - | Total ice pond vol. per unit area| m | 113 114 !!===================================================================== … … 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 … … 332 334 333 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 334 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 335 338 … … 448 451 449 452 ii = ii + 1 450 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) ) 451 454 452 455 ! * Old values of global variables -
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 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icethd_pnd.F90
r11317 r11518 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 ! … … 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/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icevar.F90
r11507 r11518 159 159 tm_s (:,:) = rt0 160 160 END WHERE 161 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 ! 162 167 DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 168 ! 163 169 ENDIF 164 170 ! … … 659 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 660 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 661 IF 667 IF( ln_pnd_H12 ) THEN 662 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 663 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 … … 780 786 !! ** Purpose : converting N-cat ice to jpl ice categories 781 787 !!------------------------------------------------------------------- 782 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, &783 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_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 ) 784 790 !!------------------------------------------------------------------- 785 791 !! ** Purpose : converting 1-cat ice to 1 ice category … … 787 793 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 788 794 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 789 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal790 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal795 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 791 797 !!------------------------------------------------------------------- 792 798 ! == thickness and concentration == ! … … 795 801 pa_i(:) = pati(:) 796 802 ! 797 ! == temperature and salinity == !803 ! == temperature and salinity and ponds == ! 798 804 pt_i (:) = ptmi (:) 799 805 pt_s (:) = ptms (:) 800 806 pt_su(:) = ptmsu(:) 801 807 ps_i (:) = psmi (:) 808 pa_ip(:) = patip(:) 809 ph_ip(:) = phtip(:) 802 810 803 811 END SUBROUTINE ice_var_itd_1c1c 804 812 805 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, &806 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_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 ) 807 815 !!------------------------------------------------------------------- 808 816 !! ** Purpose : converting N-cat ice to 1 ice category … … 810 818 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 811 819 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 812 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal813 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal820 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 814 822 ! 815 823 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 843 851 pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 844 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 845 859 ! 846 860 DEALLOCATE( z1_ai, z1_vi, z1_vs ) … … 848 862 END SUBROUTINE ice_var_itd_Nc1c 849 863 850 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, &851 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_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 ) 852 866 !!------------------------------------------------------------------- 853 867 !! … … 880 894 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 881 895 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 882 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal883 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal896 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 897 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 884 898 ! 885 899 INTEGER , DIMENSION(4) :: itest 900 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra 886 901 INTEGER :: ji, jk, jl 887 902 INTEGER :: idim, i_fill, jl0 … … 997 1012 ! == temperature and salinity == ! 998 1013 DO jl = 1, jpl 999 pt_i(:,jl) = ptmi (:) 1014 pt_i (:,jl) = ptmi (:) 1015 pt_s (:,jl) = ptms (:) 1016 pt_su(:,jl) = ptmsu(:) 1017 ps_i (:,jl) = psmi (:) 1018 ps_i (:,jl) = psmi (:) 1000 1019 END DO 1020 ! 1021 ! == ponds == ! 1022 ALLOCATE( zfra(idim) ) 1023 ! keep the same pond fraction atip/ati for each category 1024 WHERE( pati(:) /= 0._wp ) ; zfra(:) = patip(:) / pati(:) 1025 ELSEWHERE ; zfra(:) = 0._wp 1026 END WHERE 1001 1027 DO jl = 1, jpl 1002 p t_s (:,jl) = ptms (:)1028 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1003 1029 END DO 1030 ! keep the same v_ip/v_i ratio for each category 1031 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 1032 ELSEWHERE ; zfra(:) = 0._wp 1033 END WHERE 1004 1034 DO jl = 1, jpl 1005 pt_su(:,jl) = ptmsu(:) 1035 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1036 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1037 END WHERE 1006 1038 END DO 1007 DO jl = 1, jpl 1008 ps_i (:,jl) = psmi (:) 1009 END DO 1039 DEALLOCATE( zfra ) 1010 1040 ! 1011 1041 END SUBROUTINE ice_var_itd_1cMc 1012 1042 1013 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, &1014 & ptmi, ptms, ptmsu, psmi, p t_i, pt_s, pt_su, ps_i)1043 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1044 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 1015 1045 !!------------------------------------------------------------------- 1016 1046 !! … … 1043 1073 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1044 1074 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1045 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal1046 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal1075 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 1076 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 1047 1077 ! 1048 1078 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 1049 1079 INTEGER , ALLOCATABLE, DIMENSION(:) :: jlmax, jlmin 1050 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp 1080 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp, zfra 1051 1081 ! 1052 1082 REAL(wp), PARAMETER :: ztrans = 0.25_wp … … 1066 1096 pa_i(:,:) = pati(:,:) 1067 1097 ! 1068 ! == temperature and salinity == !1098 ! == temperature and salinity and ponds == ! 1069 1099 pt_i (:,:) = ptmi (:,:) 1070 1100 pt_s (:,:) = ptms (:,:) 1071 1101 pt_su(:,:) = ptmsu(:,:) 1072 1102 ps_i (:,:) = psmi (:,:) 1103 pa_ip(:,:) = patip(:,:) 1104 ph_ip(:,:) = phtip(:,:) 1073 1105 ! ! ---------------------- ! 1074 1106 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1075 1107 ! ! ---------------------- ! 1076 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1077 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 1108 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1109 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1110 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 1111 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) ) 1078 1112 ! ! ---------------------- ! 1079 1113 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1080 1114 ! ! ---------------------- ! 1081 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1082 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) ) 1115 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1116 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1117 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 1118 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) ) 1083 1119 ! ! ----------------------- ! 1084 1120 ELSE ! input cat /= output cat ! … … 1202 1238 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1203 1239 ! 1240 ! == ponds == ! 1241 ALLOCATE( zfra(idim) ) 1242 ! keep the same pond fraction atip/ati for each category 1243 WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp ) ; zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 1244 ELSEWHERE ; zfra(:) = 0._wp 1245 END WHERE 1246 DO jl = 1, jpl 1247 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1248 END DO 1249 ! keep the same v_ip/v_i ratio for each category 1250 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1251 zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1252 ELSEWHERE 1253 zfra(:) = 0._wp 1254 END WHERE 1255 DO jl = 1, jpl 1256 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1257 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1258 END WHERE 1259 END DO 1260 DEALLOCATE( zfra ) 1261 ! 1204 1262 ENDIF 1205 1263 ! -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icewri.F90
r11371 r11518 114 114 ! melt ponds 115 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 116 117 IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area 117 118 ! salt
Note: See TracChangeset
for help on using the changeset viewer.
