Changeset 11507 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icevar.F90
- Timestamp:
- 2019-09-06T17:19:33+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/icevar.F90
r11397 r11507 47 47 !! ice_var_zapneg : remove negative ice fields 48 48 !! ice_var_roundoff : remove negative values arising from roundoff erros 49 !! ice_var_itd : convert N-cat to M-cat50 49 !! ice_var_bv : brine volume 51 50 !! ice_var_enthalpy : compute ice and snow enthalpies from temperature 52 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 !! ice_var_itd : convert N-cat to M-cat 53 53 !!---------------------------------------------------------------------- 54 54 USE dom_oce ! ocean space and time domain … … 787 787 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 788 788 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 789 REAL(wp), DIMENSION(:), INTENT(in) , OPTIONAL:: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal790 REAL(wp), DIMENSION(:), INTENT(inout) , OPTIONAL:: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal789 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal 790 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal 791 791 !!------------------------------------------------------------------- 792 792 ! == thickness and concentration == ! … … 796 796 ! 797 797 ! == temperature and salinity == ! 798 IF( PRESENT( pt_i ) )pt_i (:) = ptmi (:)799 IF( PRESENT( pt_s ) )pt_s (:) = ptms (:)800 IF( PRESENT( pt_su ) )pt_su(:) = ptmsu(:)801 IF( PRESENT( ps_i ) )ps_i (:) = psmi (:)798 pt_i (:) = ptmi (:) 799 pt_s (:) = ptms (:) 800 pt_su(:) = ptmsu(:) 801 ps_i (:) = psmi (:) 802 802 803 803 END SUBROUTINE ice_var_itd_1c1c … … 810 810 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 811 811 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 812 REAL(wp), DIMENSION(:,:), INTENT(in) , OPTIONAL:: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal813 REAL(wp), DIMENSION(:) , INTENT(inout) , OPTIONAL:: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal812 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal 813 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal 814 814 ! 815 815 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 821 821 ! 822 822 ! == thickness and concentration == ! 823 ALLOCATE( z1_ai(idim) )823 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim) ) 824 824 ! 825 825 pa_i(:) = SUM( pati(:,:), dim=2 ) … … 833 833 ! 834 834 ! == temperature and salinity == ! 835 IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 836 ! 837 ALLOCATE( z1_vi(idim), z1_vs(idim) ) 838 ! 839 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 840 ELSEWHERE ; z1_vi(:) = 0._wp 841 END WHERE 842 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 843 ELSEWHERE ; z1_vs(:) = 0._wp 844 END WHERE 845 ! 846 IF( PRESENT( pt_i ) ) pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 847 IF( PRESENT( pt_s ) ) pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 848 IF( PRESENT( pt_su ) ) pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 849 IF( PRESENT( ps_i ) ) ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 850 ! 851 DEALLOCATE( z1_vi, z1_vs ) 852 ! 853 ENDIF 854 ! 855 DEALLOCATE( z1_ai ) 835 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 836 ELSEWHERE ; z1_vi(:) = 0._wp 837 END WHERE 838 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 839 ELSEWHERE ; z1_vs(:) = 0._wp 840 END WHERE 841 pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 842 pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 843 pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 844 ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 845 ! 846 DEALLOCATE( z1_ai, z1_vi, z1_vs ) 856 847 ! 857 848 END SUBROUTINE ice_var_itd_Nc1c … … 889 880 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 890 881 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 891 REAL(wp), DIMENSION(:) , INTENT(in) , OPTIONAL:: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal892 REAL(wp), DIMENSION(:,:), INTENT(inout) , OPTIONAL:: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal882 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal 883 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal 893 884 ! 894 885 INTEGER , DIMENSION(4) :: itest … … 1005 996 ! 1006 997 ! == temperature and salinity == ! 1007 IF( PRESENT( pt_i ) ) THEN 1008 DO jl = 1, jpl 1009 pt_i(:,jl) = ptmi (:) 1010 END DO 1011 ENDIF 1012 IF( PRESENT( pt_s ) ) THEN 1013 DO jl = 1, jpl 1014 pt_s (:,jl) = ptms (:) 1015 END DO 1016 ENDIF 1017 IF( PRESENT( pt_su ) ) THEN 1018 DO jl = 1, jpl 1019 pt_su(:,jl) = ptmsu(:) 1020 END DO 1021 ENDIF 1022 IF( PRESENT( ps_i ) ) THEN 1023 DO jl = 1, jpl 1024 ps_i (:,jl) = psmi (:) 1025 END DO 1026 ENDIF 998 DO jl = 1, jpl 999 pt_i(:,jl) = ptmi (:) 1000 END DO 1001 DO jl = 1, jpl 1002 pt_s (:,jl) = ptms (:) 1003 END DO 1004 DO jl = 1, jpl 1005 pt_su(:,jl) = ptmsu(:) 1006 END DO 1007 DO jl = 1, jpl 1008 ps_i (:,jl) = psmi (:) 1009 END DO 1027 1010 ! 1028 1011 END SUBROUTINE ice_var_itd_1cMc … … 1060 1043 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1061 1044 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1062 REAL(wp), DIMENSION(:,:), INTENT(in) , OPTIONAL:: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal1063 REAL(wp), DIMENSION(:,:), INTENT(inout) , OPTIONAL:: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal1045 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi ! input ice/snow temp & sal 1046 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i ! output ice/snow temp & sal 1064 1047 ! 1065 1048 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 … … 1084 1067 ! 1085 1068 ! == temperature and salinity == ! 1086 IF( PRESENT( pt_i ) )pt_i (:,:) = ptmi (:,:)1087 IF( PRESENT( pt_s ) )pt_s (:,:) = ptms (:,:)1088 IF( PRESENT( pt_su ) )pt_su(:,:) = ptmsu(:,:)1089 IF( PRESENT( ps_i ) )ps_i (:,:) = psmi (:,:)1069 pt_i (:,:) = ptmi (:,:) 1070 pt_s (:,:) = ptms (:,:) 1071 pt_su(:,:) = ptmsu(:,:) 1072 ps_i (:,:) = psmi (:,:) 1090 1073 ! ! ---------------------- ! 1091 1074 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1092 1075 ! ! ---------------------- ! 1093 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), ph_i(:,:), ph_s(:,:), pa_i (:,:) ) 1094 !! CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1095 !! & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 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(:,:) ) 1096 1078 ! ! ---------------------- ! 1097 1079 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1098 1080 ! ! ---------------------- ! 1099 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), ph_i(:,1), ph_s(:,1), pa_i (:,1) ) 1100 !! CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1101 !! & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) ) 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) ) 1102 1083 ! ! ----------------------- ! 1103 1084 ELSE ! input cat /= output cat ! … … 1189 1170 ! == temperature and salinity == ! 1190 1171 ! 1191 IF( PRESENT( pt_i ) .OR. PRESENT( pt_s ) .OR. PRESENT( pt_su ) .OR. PRESENT( ps_i ) ) THEN 1192 ! 1193 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1194 ! 1195 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1196 ELSEWHERE ; z1_ai(:) = 0._wp 1197 END WHERE 1198 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1199 ELSEWHERE ; z1_vi(:) = 0._wp 1200 END WHERE 1201 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1202 ELSEWHERE ; z1_vs(:) = 0._wp 1203 END WHERE 1204 ! 1205 ! fill all the categories with the same value 1206 IF( PRESENT( pt_i ) ) THEN 1207 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1208 DO jl = 1, jpl 1209 pt_i (:,jl) = ztmp(:) 1210 END DO 1211 ENDIF 1212 IF( PRESENT( pt_s ) ) THEN 1213 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1214 DO jl = 1, jpl 1215 pt_s (:,jl) = ztmp(:) 1216 END DO 1217 ENDIF 1218 IF( PRESENT( pt_su ) ) THEN 1219 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1220 DO jl = 1, jpl 1221 pt_su(:,jl) = ztmp(:) 1222 END DO 1223 ENDIF 1224 IF( PRESENT( ps_i ) ) THEN 1225 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1226 DO jl = 1, jpl 1227 ps_i (:,jl) = ztmp(:) 1228 END DO 1229 ENDIF 1230 ! 1231 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1232 ! 1233 ENDIF 1172 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1173 ! 1174 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1175 ELSEWHERE ; z1_ai(:) = 0._wp 1176 END WHERE 1177 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1178 ELSEWHERE ; z1_vi(:) = 0._wp 1179 END WHERE 1180 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1181 ELSEWHERE ; z1_vs(:) = 0._wp 1182 END WHERE 1183 ! 1184 ! fill all the categories with the same value 1185 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1186 DO jl = 1, jpl 1187 pt_i (:,jl) = ztmp(:) 1188 END DO 1189 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1190 DO jl = 1, jpl 1191 pt_s (:,jl) = ztmp(:) 1192 END DO 1193 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1194 DO jl = 1, jpl 1195 pt_su(:,jl) = ztmp(:) 1196 END DO 1197 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1198 DO jl = 1, jpl 1199 ps_i (:,jl) = ztmp(:) 1200 END DO 1201 ! 1202 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1234 1203 ! 1235 1204 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
