Changeset 1463 for trunk/NEMO/OPA_SRC/SBC/sbccpl.F90
- Timestamp:
- 2009-06-09T16:45:31+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SBC/sbccpl.F90
r1308 r1463 816 816 817 817 818 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi , psst , pist, & 819 & pqns_tot, pqns_ice, & 820 & pqsr_tot, pqsr_ice, & 821 & pemp_tot, pemp_ice, pdqns_ice, psprecip ) 818 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist , & 819 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 820 & pemp_tot, pemp_ice, pdqns_ice, psprecip ) 822 821 !!---------------------------------------------------------------------- 823 822 !! *** ROUTINE sbc_cpl_ice_flx_rcv *** … … 863 862 !! wndm 10m wind module 864 863 !!---------------------------------------------------------------------- 865 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj ) :: p_frld ! lead fraction [0 to 1]866 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj ) :: palbi ! ice albedo867 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj ) :: psst ! sea surface temperature [Celcius]868 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj ) :: pist ! ice surface temperature [Kelvin]869 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqns_tot ! total non solar heat flux [W/m2]870 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqns_ice ! ice non solar heat flux [W/m2]871 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqsr_tot ! total solar heat flux [W/m2]872 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqsr_ice ! ice solar heat flux [W/m2]873 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pemp_tot ! total freshwater budget [Kg/m2/s]874 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s]875 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s]876 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice864 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpl) :: p_frld ! lead fraction [0 to 1] 865 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpl) :: palbi ! ice albedo 866 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj ) :: psst ! sea surface temperature [Celcius] 867 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpl) :: pist ! ice surface temperature [Kelvin] 868 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqns_tot ! total non solar heat flux [W/m2] 869 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpl) :: pqns_ice ! ice non solar heat flux [W/m2] 870 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pqsr_tot ! total solar heat flux [W/m2] 871 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpl) :: pqsr_ice ! ice solar heat flux [W/m2] 872 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 873 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s] 874 REAL(wp), INTENT( out), DIMENSION(jpi,jpj ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s] 875 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpl) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 877 876 !! 878 877 INTEGER :: ji, jj ! dummy loop indices … … 895 894 zsnow (:,:) = frcv(:,:,jpr_snow) 896 895 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 897 pemp_tot(:,:) = p_frld(:,: ) * frcv(:,:,jpr_oemp) + (1.- p_frld(:,:)) * frcv(:,:,jpr_sbpr)896 pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + (1.- p_frld(:,:,1)) * frcv(:,:,jpr_sbpr) 898 897 pemp_ice(:,:) = frcv(:,:,jpr_semp) 899 898 zsnow (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp) … … 925 924 ! ! ========================= ! 926 925 CASE( 'conservative' ) ! the required fields are directly provided 927 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix)928 pqns_ice(:,: ) = frcv(:,:,jpr_qnsice)926 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 927 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 929 928 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 930 pqns_tot(:,: ) = p_frld(:,:) * frcv(:,:,jpr_qnsoce) + ( 1.- p_frld(:,:) ) * frcv(:,:,jpr_qnsice)931 pqns_ice(:,: ) = frcv(:,:,jpr_qnsice)929 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + ( 1.- p_frld(:,:,1) ) * frcv(:,:,jpr_qnsice) 930 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 932 931 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 933 pqns_tot(:,:) = frcv(:,:,jpr_qnsmix) 934 pqns_ice(:,:) = frcv(:,:,jpr_qnsmix) & 935 & + frcv(:,:,jpr_dqnsdt) * ( pist(:,:) - ( (rt0 + psst(:,:))*p_frld(:,:) + pist(:,:)*(1. - p_frld(:,:)) ) ) 932 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 933 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix) & 934 & + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 935 & + pist(:,:,1) * ( 1. - p_frld(:,:,1) ) ) ) 936 936 END SELECT 937 937 ! ! snow melting heat flux .... 938 938 ! energy for melting solid precipitation over free ocean 939 939 zcoef = xlsn / rhosn 940 pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,: ) * zsnow(:,:) * zcoef940 pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,:,1) * zsnow(:,:) * zcoef 941 941 !!gm 942 942 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 951 951 ! ! ========================= ! 952 952 CASE( 'conservative' ) 953 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix)954 pqsr_ice(:,: ) = frcv(:,:,jpr_qsrice)953 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 954 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 955 955 CASE( 'oce and ice' ) 956 pqsr_tot(:,: ) = p_frld(:,:) * frcv(:,:,jpr_qsroce) + ( 1.- p_frld(:,:) ) * frcv(:,:,jpr_qsrice)957 pqsr_ice(:,: ) = frcv(:,:,jpr_qsrice)956 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + ( 1.- p_frld(:,:,1) ) * frcv(:,:,jpr_qsrice) 957 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 958 958 CASE( 'mixed oce-ice' ) 959 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix)959 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 960 960 ! Create solar heat flux over ice using incoming solar heat flux and albedos 961 961 ! ( see OASIS3 user guide, 5th edition, p39 ) 962 pqsr_ice(:,: ) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:) ) &963 & / ( 1.- ( albedo_oce_mix(:,:) * ( 1.- p_frld(:,:) ) &964 & + palbi (:,:) * p_frld(:,:) ) )962 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) ) & 963 & / ( 1.- ( albedo_oce_mix(:,: ) * ( 1.- p_frld(:,:,1) ) & 964 & + palbi (:,:,1) * p_frld(:,:,1) ) ) 965 965 END SELECT 966 966 … … 968 968 SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 969 969 CASE ('coupled') 970 pdqns_ice(:,: ) = frcv(:,:,jpr_dqnsdt)970 pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 971 971 END SELECT 972 972 … … 1009 1009 CASE( 'oce only' ) ; ztmp1(:,:) = tn(:,:,1) + rt0 1010 1010 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) 1011 ztmp2(:,:) = tn_ice(:,: )* fr_i(:,:)1012 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,: ) * fr_i(:,:)1011 ztmp2(:,:) = tn_ice(:,:,1) * fr_i(:,:) 1012 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 1013 1013 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 1014 1014 END SELECT … … 1021 1021 ! ! ------------------------- ! 1022 1022 IF( ssnd(jps_albice)%laction ) THEN ! ice 1023 ztmp1(:,:) = alb_ice(:,: ) * fr_i(:,:)1023 ztmp1(:,:) = alb_ice(:,:,1) * fr_i(:,:) 1024 1024 CALL cpl_prism_snd( jps_albice, isec, ztmp1, info ) 1025 1025 ENDIF 1026 1026 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1027 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,: ) * fr_i(:,:)1027 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 1028 1028 CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 1029 1029 ENDIF … … 1155 1155 END SUBROUTINE sbc_cpl_ice_tau 1156 1156 ! 1157 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi , psst , pist, & 1158 & pqns_tot, pqns_ice, & 1159 & pqsr_tot, pqsr_ice, & 1160 & pemp_tot, pemp_ice, pdqns_ice, psprecip ) 1161 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1162 REAL(wp), INTENT(in ), DIMENSION(:,:) :: palbi ! ice albedo 1163 REAL(wp), INTENT(in ), DIMENSION(:,:) :: psst ! sea surface temperature [Celcius] 1164 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pist ! ice surface temperature [Celcius] 1165 REAL(wp), INTENT( out), DIMENSION(:,:) :: pqns_tot ! total non solar heat flux [W/m2] 1166 REAL(wp), INTENT( out), DIMENSION(:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1167 REAL(wp), INTENT( out), DIMENSION(:,:) :: pqsr_tot ! total solar heat flux [W/m2] 1168 REAL(wp), INTENT( out), DIMENSION(:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1169 REAL(wp), INTENT( out), DIMENSION(:,:) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1170 REAL(wp), INTENT( out), DIMENSION(:,:) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s] 1171 REAL(wp), INTENT( out), DIMENSION(:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1172 REAL(wp), INTENT( out), DIMENSION(:,:) :: psprecip ! solid precipitation [Kg/m2/s] 1173 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1), psst(1,1), pist(1,1) 1157 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist , & 1158 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1159 & pemp_tot, pemp_ice, pdqns_ice, psprecip ) 1160 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1161 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palbi ! ice albedo 1162 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: psst ! sea surface temperature [Celcius] 1163 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pist ! ice surface temperature [Kelvin] 1164 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1165 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1166 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1167 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1168 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1169 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s] 1170 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1171 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! solid precipitation [Kg/m2/s] 1172 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1174 1173 ! stupid definition to avoid warning message when compiling... 1175 pqns_tot(:,:) = 0. ; pqns_ice(:,: ) = 0. ; pdqns_ice(:,:) = 0.1176 pqsr_tot(:,:) = 0. ; pqsr_ice(:,: ) = 0.1177 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0.1174 pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 1175 pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0. 1176 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0. 1178 1177 END SUBROUTINE sbc_cpl_ice_flx 1179 1178
Note: See TracChangeset
for help on using the changeset viewer.
