- Timestamp:
- 2020-04-08T18:54:44+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icevar.F90
r11732 r12720 113 113 at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 114 114 vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 115 vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 115 116 ! 116 117 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction … … 161 162 ! 162 163 ! ! mean melt pond depth 163 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 164 ELSEWHERE ; hm_ip(:,:) = 0._wp 164 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 165 ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp 165 166 END WHERE 166 167 ! … … 221 222 WHERE( a_ip_frac(:,:,:) > epsi20 ) ; h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 222 223 ELSEWHERE ; h_ip(:,:,:) = 0._wp 224 END WHERE 225 ! !--- pond lid thickness 226 WHERE( a_ip_frac(:,:,:) > epsi20 ) ; h_il(:,:,:) = v_il(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 227 ELSEWHERE ; h_il(:,:,:) = 0._wp 223 228 END WHERE 224 229 ! … … 289 294 sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 290 295 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 296 v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 291 297 ! 292 298 END SUBROUTINE ice_var_eqv2glo … … 533 539 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 534 540 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 541 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 535 542 ! 536 543 END DO … … 555 562 556 563 557 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )564 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 558 565 !!------------------------------------------------------------------- 559 566 !! *** ROUTINE ice_var_zapneg *** … … 570 577 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 571 578 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 579 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 572 580 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 573 581 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 636 644 WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp 637 645 WHERE( pv_ip (:,:,:) < 0._wp ) pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 638 !but it does not change conservation, so keep it this way is ok646 WHERE( pv_il (:,:,:) < 0._wp ) pv_il (:,:,:) = 0._wp ! but it does not change conservation, so keep it this way is ok 639 647 ! 640 648 END SUBROUTINE ice_var_zapneg 641 649 642 650 643 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, p e_s, pe_i )651 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 644 652 !!------------------------------------------------------------------- 645 653 !! *** ROUTINE ice_var_roundoff *** … … 654 662 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 655 663 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_ip ! melt pond volume 664 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 656 665 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content 657 666 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 668 677 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 669 678 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 679 WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0 670 680 ENDIF 671 681 ! … … 786 796 !! ** Purpose : converting N-cat ice to jpl ice categories 787 797 !!------------------------------------------------------------------- 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)798 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 799 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 790 800 !!------------------------------------------------------------------- 791 801 !! ** Purpose : converting 1-cat ice to 1 ice category … … 793 803 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 794 804 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 & ponds796 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds805 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 806 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 797 807 !!------------------------------------------------------------------- 798 808 ! == thickness and concentration == ! … … 808 818 pa_ip(:) = patip(:) 809 819 ph_ip(:) = phtip(:) 820 ph_il(:) = phtil(:) 810 821 811 822 END SUBROUTINE ice_var_itd_1c1c 812 823 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)824 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 825 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 815 826 !!------------------------------------------------------------------- 816 827 !! ** Purpose : converting N-cat ice to 1 ice category … … 818 829 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 819 830 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 & ponds821 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds831 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 832 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 822 833 ! 823 834 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 854 865 ! == ponds == ! 855 866 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 867 WHERE( pa_ip(:) /= 0._wp ) 868 ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 869 ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 870 ELSEWHERE 871 ph_ip(:) = 0._wp 872 ph_il(:) = 0._wp 858 873 END WHERE 859 874 ! … … 862 877 END SUBROUTINE ice_var_itd_Nc1c 863 878 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)879 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 880 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 866 881 !!------------------------------------------------------------------- 867 882 !! … … 885 900 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 886 901 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 & ponds888 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds902 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 903 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 889 904 ! 890 905 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra, z1_hti … … 997 1012 END WHERE 998 1013 END DO 1014 ! keep the same v_il/v_i ratio for each category 1015 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 1016 ELSEWHERE ; zfra(:) = 0._wp 1017 END WHERE 1018 DO jl = 1, jpl 1019 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1020 ELSEWHERE ; ph_il(:,jl) = 0._wp 1021 END WHERE 1022 END DO 999 1023 DEALLOCATE( zfra ) 1000 1024 ! 1001 1025 END SUBROUTINE ice_var_itd_1cMc 1002 1026 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)1027 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1028 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 1005 1029 !!------------------------------------------------------------------- 1006 1030 !! … … 1033 1057 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1034 1058 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 & ponds1036 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds1059 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 1060 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 1037 1061 ! 1038 1062 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 … … 1063 1087 pa_ip(:,:) = patip(:,:) 1064 1088 ph_ip(:,:) = phtip(:,:) 1089 ph_il(:,:) = phtil(:,:) 1065 1090 ! ! ---------------------- ! 1066 1091 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! … … 1068 1093 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1069 1094 & 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(:,:) )1095 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 1096 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:) ) 1072 1097 ! ! ---------------------- ! 1073 1098 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! … … 1075 1100 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1076 1101 & 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) )1102 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 1103 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1) ) 1079 1104 ! ! ----------------------- ! 1080 1105 ELSE ! input cat /= output cat ! … … 1218 1243 END WHERE 1219 1244 END DO 1245 ! keep the same v_il/v_i ratio for each category 1246 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1247 zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1248 ELSEWHERE 1249 zfra(:) = 0._wp 1250 END WHERE 1251 DO jl = 1, jpl 1252 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1253 ELSEWHERE ; ph_il(:,jl) = 0._wp 1254 END WHERE 1255 END DO 1220 1256 DEALLOCATE( zfra ) 1221 1257 !
Note: See TracChangeset
for help on using the changeset viewer.
