Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/hydrolc.f90
- Timestamp:
- 2011-06-17T14:02:17+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/hydrolc.f90
r134 r257 3 3 !! 4 4 !! @author Marie-Alice Foujols and Jan Polcher 5 !! @Version : $Revision: 1.21 $, $Date: 2010/05/07 08:28:13$5 !! @Version : $Revision: 45 $, $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 6 6 !! 7 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/hydrolc.f90,v 1.21 2010/05/07 08:28:13 ssipsl Exp $ 7 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/hydrolc.f90 $ 8 !< $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 9 !< $Author: mmaipsl $ 10 !< $Revision: 45 $ 8 11 !! IPSL (2006) 9 12 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 145 148 !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency. 146 149 !! The water balance is limite to + or - 10^6 so that accumulation is not endless 150 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel !! Relative humidity 151 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vegstress !! Veg. moisture stress (only for vegetation growth) 152 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on vegetation due to interception 147 153 ! output fields 148 REAL(r_std),DIMENSION (kjpindex), INTENT ( out) :: run_off_tot !! Complete runoff149 REAL(r_std),DIMENSION (kjpindex), INTENT ( out) :: drainage !! Drainage150 REAL(r_std),DIMENSION (kjpindex,n vm), INTENT (out) :: humrel !! Relative humidity151 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth) 154 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: run_off_tot !! Complete runoff 155 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: drainage !! Drainage 156 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout):: shumdiag !! relative soil moisture 157 152 158 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: rsol !! Resistence to bare soil evaporation 153 159 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Fraction of visibly dry soil (between 0 and 1) 154 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag !! relative soil moisture155 160 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity 156 161 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_melt !! Total melt 157 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception158 162 159 163 ! … … 293 297 CALL hydrolc_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet) 294 298 ENDIF 295 296 299 297 300 ! … … 313 316 DO ji = 1, kjpindex 314 317 IF ( vegtot(ji) .GT. zero ) THEN 315 histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, 0.0)318 histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, zero) 316 319 ENDIF 317 320 ENDDO … … 322 325 CALL histwrite(hist_id, 'mrso', kjit, histvar, kjpindex, index) 323 326 324 histvar(:)=run_off_tot(:)/ 86400.327 histvar(:)=run_off_tot(:)/one_day 325 328 CALL histwrite(hist_id, 'mrros', kjit, histvar, kjpindex, index) 326 329 327 histvar(:)=(run_off_tot(:)+drainage(:))/ 86400.330 histvar(:)=(run_off_tot(:)+drainage(:))/one_day 328 331 CALL histwrite(hist_id, 'mrro', kjit, histvar, kjpindex, index) 329 332 330 histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))/ 86400.333 histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))/one_day 331 334 CALL histwrite(hist_id, 'prveg', kjit, histvar, kjpindex, index) 332 335 … … 369 372 DO ji = 1, kjpindex 370 373 IF ( vegtot(ji) .GT. zero ) THEN 371 histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, 0.0)374 histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, zero) 372 375 ENDIF 373 376 ENDDO … … 375 378 CALL histwrite(hist2_id, 'mrsos', kjit, histvar, kjpindex, index) 376 379 377 histvar(:)=(run_off_tot(:)+drainage(:))/ 86400.380 histvar(:)=(run_off_tot(:)+drainage(:))/one_day 378 381 CALL histwrite(hist2_id, 'mrro', kjit, histvar, kjpindex, index) 379 382 … … 772 775 !Config started without a restart file. 773 776 ! 774 CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', 0.0_r_std)777 CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero) 775 778 ! 776 779 !Config Key = HYDROL_SNOWAGE … … 781 784 !Config started without a restart file. 782 785 ! 783 CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', 0.0_r_std)786 CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero) 784 787 ! 785 788 !Config Key = HYDROL_SNOW_NOBIO … … 790 793 !Config started without a restart file. 791 794 ! 792 CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', 0.0_r_std)795 CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero) 793 796 ! 794 797 !Config Key = HYDROL_SNOW_NOBIO_AGE … … 799 802 !Config started without a restart file. 800 803 ! 801 CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', 0.0_r_std)804 CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero) 802 805 ! 803 806 !Config Key = HYDROL_HUMR … … 808 811 !Config started without a restart file. 809 812 ! 810 CALL setvar_p (humrel, val_exp,'HYDROL_HUMR', 1.0_r_std)811 CALL setvar_p (vegstress, val_exp,'HYDROL_HUMR', 1.0_r_std)813 CALL setvar_p (humrel, val_exp,'HYDROL_HUMR', un) 814 CALL setvar_p (vegstress, val_exp,'HYDROL_HUMR', un) 812 815 ! 813 816 !Config Key = HYDROL_BQSB … … 827 830 !Config started without a restart file. 828 831 ! 829 CALL setvar_p (gqsb, val_exp, 'HYDROL_GQSB', 0.0_r_std)832 CALL setvar_p (gqsb, val_exp, 'HYDROL_GQSB', zero) 830 833 ! 831 834 !Config Key = HYDROL_DSG … … 836 839 !Config started without a restart file. 837 840 ! 838 CALL setvar_p (dsg, val_exp, 'HYDROL_DSG', 0.0_r_std)841 CALL setvar_p (dsg, val_exp, 'HYDROL_DSG', zero) 839 842 840 843 ! set inital value for dsp if needed … … 872 875 !Config the model is started without a restart file. 873 876 ! 874 CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', 0.0_r_std)877 CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero) 875 878 ! 876 879 tmpdss = dsg - gqsb / mx_eau_eau … … 889 892 IF (.NOT. (dsg(ji,1).EQ. zero .OR. gqsb(ji,1).EQ.zero)) THEN 890 893 ! Ajouts Nathalie - Fred - le 28 Mars 2006 891 a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1), 0.)/dsg_min,1.)894 a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1),zero)/dsg_min,un) 892 895 ! 893 896 ENDIF … … 906 909 IF (.NOT. (dsg(ji,1).EQ. zero .OR. gqsb(ji,1).EQ.zero)) THEN 907 910 ! Ajouts Nathalie - Fred - le 28 Mars 2006 908 a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1), 0.)/dsg_min,1.)911 a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1),zero)/dsg_min,un) 909 912 ! 910 913 ENDIF … … 915 918 ! Correction Nathalie - le 28 Mars 2006 - re-ecriture drysoil_frac/hdry - Fred Hourdin 916 919 ! revu 22 novembre 2007 917 hdry(:) = a_subgrd(:)*dss(:,1) + ( 1.-a_subgrd(:))*dsp(:,1)920 hdry(:) = a_subgrd(:)*dss(:,1) + (un-a_subgrd(:))*dsp(:,1) 918 921 ENDIF 919 922 ! … … 1090 1093 1091 1094 ! The fraction of soil which is visibly dry (dry when dss = 0.1 m) 1092 drysoil_frac(:) = MIN(MAX(dss(:,1), 0.)*10._r_std, un)1095 drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un) 1093 1096 ! 1094 1097 ! Compute the resistance to bare soil evaporation … … 1102 1105 ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70 1103 1106 !rsol(ji) = dss(ji,1) * rsol_cste 1104 !rsol(ji) = ( drysoil_frac(ji) + 1./(10.*(dpu_cste - drysoil_frac(ji))+1.e-10)**2 ) * rsol_cste1105 rsol(ji) = ( hdry(ji) + 1./(10.*(dpu_cste - hdry(ji))+1.e-10)**2 ) * rsol_cste1107 !rsol(ji) = ( drysoil_frac(ji) + un/(10.*(dpu_cste - drysoil_frac(ji))+1.e-10)**2 ) * rsol_cste 1108 rsol(ji) = ( hdry(ji) + un/(10.*(dpu_cste - hdry(ji))+1.e-10)**2 ) * rsol_cste 1106 1109 ENDIF 1107 1110 ENDDO … … 1124 1127 !!$ ( mean_dsg(ji) .GT. min_sechiba ) .AND. & 1125 1128 !!$ ( mean_dsg(ji) .LT. 5.E-4 ) ) THEN 1126 !!$ litterhumdiag(ji) = 0.01129 !!$ litterhumdiag(ji) = zero 1127 1130 !!$ ENDIF 1128 1131 !!$ ENDDO … … 1273 1276 IF (snow(ji).GT.sneige) THEN 1274 1277 ! 1275 snowmelt(ji) = ( 1.- frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu01278 snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0 1276 1279 ! 1277 1280 ! 1.3.1.1 enough snow for melting or not … … 1409 1412 & (un - snow_nobio_age(ji,iice)/max_snow_age) * dtradia/one_day ) * & 1410 1413 & EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice) 1411 IF (d_age(ji) .GT. 0.) THEN1414 IF (d_age(ji) .GT. zero ) THEN 1412 1415 xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero ) 1413 1416 xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std … … 1456 1459 REAL(r_std), DIMENSION (kjpindex,nvm) :: zqsintvegnew 1457 1460 LOGICAL, SAVE :: firstcall=.TRUE. 1458 ! REAL(r_std), SAVE, DIMENSION(nvm) :: throughfall_by_pft1459 1461 1460 1462 IF ( firstcall ) THEN … … 1578 1580 ENDIF 1579 1581 ! 1580 IF (resdist(ji,jv) .GT. 0.) THEN1582 IF (resdist(ji,jv) .GT. zero) THEN 1581 1583 qsintveg2(ji,jv) = qsintveg(ji,jv)/resdist(ji,jv) 1582 1584 ELSE … … 1586 1588 ENDDO 1587 1589 ! 1588 vegchtot(:) = 0.1590 vegchtot(:) = zero 1589 1591 DO jv = 1, nvm 1590 1592 DO ji = 1, kjpindex … … 1595 1597 DO jv = 1, nvm 1596 1598 DO ji = 1, kjpindex 1597 IF ( vegchtot(ji) .GT. 0.) THEN1599 IF ( vegchtot(ji) .GT. zero ) THEN 1598 1600 gdq(ji,jv) = ABS(vmr(ji,jv)) * gqsb(ji,jv) 1599 1601 bdq(ji,jv) = ABS(vmr(ji,jv)) * bqsb(ji,jv) … … 1613 1615 DO jv = 1, nvm 1614 1616 DO ji = 1, kjpindex 1615 IF ( ( vegchtot(ji) .GT. 0. ) .AND. ( vmr(ji,jv) .LT. 0.) ) THEN1617 IF ( ( vegchtot(ji) .GT. zero ) .AND. ( vmr(ji,jv) .LT. zero ) ) THEN 1616 1618 gtr(ji) = gtr(ji) + gdq(ji,jv) 1617 1619 btr(ji) = btr(ji) + bdq(ji,jv) … … 1625 1627 DO jv = 1, nvm 1626 1628 DO ji = 1, kjpindex 1627 IF ( vegchtot(ji) .GT. 0..AND. ABS(vtr(ji)) .GT. EPS1) THEN1629 IF ( vegchtot(ji) .GT. zero .AND. ABS(vtr(ji)) .GT. EPS1) THEN 1628 1630 fra(ji) = vmr(ji,jv) / vtr(ji) 1629 IF ( vmr(ji,jv) .GT. 0.) THEN1630 IF (veget(ji,jv) .GT. 0.) THEN1631 IF ( vmr(ji,jv) .GT. zero) THEN 1632 IF (veget(ji,jv) .GT. zero) THEN 1631 1633 gqsb(ji,jv) = (resdist(ji,jv)*gqsb(ji,jv) + fra(ji)*gtr(ji))/veget(ji,jv) 1632 1634 bqsb(ji,jv) = (resdist(ji,jv)*bqsb(ji,jv) + fra(ji)*btr(ji))/veget(ji,jv) … … 2003 2005 IF (long_print) WRITE(numout,*) 'hydrolc_soil 3.0 : Vertical diffusion' 2004 2006 2005 mean_bqsb(:) = 0.2006 mean_gqsb(:) = 0.2007 mean_bqsb(:) = zero 2008 mean_gqsb(:) = zero 2007 2009 DO jv = 1, nvm 2008 2010 DO ji = 1, kjpindex … … 2030 2032 DO ji = 1, kjpindex 2031 2033 IF (lbad_ij(ji)) THEN 2032 IF ( veget(ji,jv) .GT. 0.) THEN2034 IF ( veget(ji,jv) .GT. zero ) THEN 2033 2035 ! 2034 2036 bqsb(ji,jv) = mean_bqsb(ji) … … 2056 2058 ! ! 2057 2059 ! DO ji = 1, kjpindex 2058 ! IF ( veget(ji,jv) .GT. 0.) THEN2060 ! IF ( veget(ji,jv) .GT. zero ) THEN 2059 2061 ! ! 2060 2062 ! bqsb(ji,jv) = mean_bqsb(ji) … … 2082 2084 ENDDO 2083 2085 ! 2084 mean_bqsb(:) = 0.2085 mean_gqsb(:) = 0.2086 mean_bqsb(:) = zero 2087 mean_gqsb(:) = zero 2086 2088 DO jv = 1, nvm 2087 2089 DO ji = 1, kjpindex … … 2180 2182 zhumrel_up(ji) = EXP( - humcste(jv) * dss(ji,jv)) 2181 2183 ! Ajouts Nathalie - Fred - le 28 Mars 2006 2182 a_subgrd(ji,jv)=MIN(MAX(dsg(ji,jv)-dss(ji,jv), 0.)/dsg_min,1.)2183 humrel(ji,jv)=a_subgrd(ji,jv)*zhumrel_up(ji)+( 1.-a_subgrd(ji,jv))*zhumrel_lo(ji)2184 a_subgrd(ji,jv)=MIN(MAX(dsg(ji,jv)-dss(ji,jv),zero)/dsg_min,un) 2185 humrel(ji,jv)=a_subgrd(ji,jv)*zhumrel_up(ji)+(un-a_subgrd(ji,jv))*zhumrel_lo(ji) 2184 2186 ! 2185 2187 vegstress(ji,jv) = zhumrel_lo(ji) + zhumrel_up(ji) - EXP( - humcste(jv) * dsg(ji,jv) ) … … 2221 2223 2222 2224 ! The fraction of visibly dry soil (dry when dss(:,1) = 0.1 m) 2223 drysoil_frac(:) = MIN(MAX(dss(:,1), 0.)*10._r_std, un)2225 drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un) 2224 2226 2225 2227 ! Correction Nathalie - le 28 Mars 2006 - re-ecriture drysoil_frac/hdry - Fred Hourdin 2226 2228 ! revu 22 novembre 2007 2227 hdry(:) = a_subgrd(:,1)*dss(:,1) + ( 1.-a_subgrd(:,1))*dsp(:,1)2229 hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 2228 2230 ! 2229 2231 ! Compute the resistance to bare soil evaporation. … … 2237 2239 ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70 2238 2240 !rsol(ji) = dss(ji,1) * rsol_cste 2239 rsol(ji) = ( hdry(ji) + 1./(10.*(dpu_cste - hdry(ji))+1.e-10)**2 ) * rsol_cste2241 rsol(ji) = ( hdry(ji) + un/(10.*(dpu_cste - hdry(ji))+1.e-10)**2 ) * rsol_cste 2240 2242 ENDIF 2241 2243 ENDDO … … 2389 2391 IF ( ABS(delta_water(ji)-tot_flux(ji)) .GT. allowed_err ) THEN 2390 2392 WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji 2391 WRITE(numout,*) 'The error in mm/d is :', (delta_water(ji)-tot_flux(ji))/dtradia , &2393 WRITE(numout,*) 'The error in mm/d is :', (delta_water(ji)-tot_flux(ji))/dtradia*one_day, & 2392 2394 & ' and in mm/dt : ', delta_water(ji)-tot_flux(ji) 2393 2395 WRITE(numout,*) 'delta_water : ', delta_water(ji), ' tot_flux : ', tot_flux(ji) … … 2520 2522 !Config Key = HYDROL_TAU_HDIFF 2521 2523 !Config Desc = time scale (s) for horizontal diffusion of water 2522 !Config Def = 86400.2524 !Config Def = one_day 2523 2525 !Config If = HYDROL_OK_HDIFF 2524 2526 !Config Help = Defines how fast diffusion occurs horizontally between … … 2526 2528 !Config diffusion. 2527 2529 2528 tau_hdiff = 86400.2530 tau_hdiff = one_day 2529 2531 CALL getin_p('HYDROL_TAU_HDIFF',tau_hdiff) 2530 2532
Note: See TracChangeset
for help on using the changeset viewer.
