Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba
- Timestamp:
- 2011-06-17T14:02:17+02:00 (13 years ago)
- Location:
- branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba
- Files:
-
- 14 edited
-
AA_make (modified) (4 diffs)
-
AA_make.ldef (modified) (1 diff)
-
condveg.f90 (modified) (6 diffs)
-
diffuco.f90 (modified) (14 diffs)
-
enerbil.f90 (modified) (11 diffs)
-
hydrol.f90 (modified) (12 diffs)
-
hydrolc.f90 (modified) (39 diffs)
-
intersurf.f90 (modified) (35 diffs)
-
sechiba.f90 (modified) (7 diffs)
-
sechiba_io.f90 (modified) (1 diff)
-
sechiba_io_p.f90 (modified) (1 diff)
-
slowproc.f90 (modified) (43 diffs)
-
thermosoil.f90 (modified) (7 diffs)
-
watchout.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/AA_make
r64 r257 1 1 #- 2 #- $Id: AA_make,v 1.22 2010/04/20 13:59:56 ssipsl Exp $ 2 #- $Id: AA_make 41 2011-01-01 19:56:53Z mmaipsl $ 3 #- 4 PARALLEL_LIB = $(LIBDIR)/libparallel.a 5 SXPARALLEL_LIB = $(PARALLEL_LIB) 6 #-Q- sxnec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a 7 #-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a 8 #-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a 9 #-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a 3 10 #- 4 11 PARAM_LIB = $(LIBDIR)/libparameters.a … … 8 15 #-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a 9 16 #-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a 10 #-11 PARALLEL_LIB = $(LIBDIR)/libparallel.a12 SXPARALLEL_LIB = $(PARALLEL_LIB)13 #-Q- sxnec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a14 #-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a15 #-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a16 #-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a17 17 #- 18 18 ORGLOB_LIB = $(LIBDIR)/liborglob.a … … 54 54 #- 55 55 all: 56 $(M_K) libparallel 56 57 $(M_K) libparameters 57 $(M_K) lib parallel58 $(M_K) liborglob 58 59 $(M_K) libstomate 59 60 $(M_K) m_all … … 63 64 #-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1)) 64 65 66 libparallel: 67 (cd ../src_parallel; $(M_K) -f Makefile) 68 65 69 libparameters: 66 70 (cd ../src_parameters; $(M_K) -f Makefile) 67 68 libparallel:69 (cd ../src_parallel; $(M_K) -f Makefile)70 71 71 72 liborglob: -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/AA_make.ldef
r64 r257 1 1 #- 2 #- $Id: AA_make.ldef ,v 1.7 2008/01/08 11:49:07 ssipsl Exp$2 #- $Id: AA_make.ldef 12 2010-11-05 15:42:13Z mmaipsl $ 3 3 #- 4 4 #--------------------------------------------------------------------- -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/condveg.f90
r104 r257 6 6 !! 7 7 !! @author Marie-Alice Foujols and Jan Polcher 8 !! @Version : $Revision: 1.30 $, $Date: 2009/01/07 13:39:45$8 !! @Version : $Revision: 45 $, $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 9 9 !! 10 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/condveg.f90,v 1.30 2009/01/07 13:39:45 ssipsl Exp $ 10 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/condveg.f90 $ 11 !< $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 12 !< $Author: mmaipsl $ 13 !< $Revision: 45 $ 11 14 !! IPSL (2006) 12 15 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 210 213 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in):: veget !! Vegetation distribution 211 214 REAL(r_std),DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geographical coordinates 212 INTEGER(i_std),DIMENSION (kjpindex, 4), INTENT(in):: neighbours !! neighoring grid points if land215 INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in):: neighbours !! neighoring grid points if land 213 216 REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x an y of the grid (m) 214 217 REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: contfrac ! Fraction of land in each grid box. … … 663 666 ! snow albedo on vegetated surfaces 664 667 ! 665 fraction_veg(:) = 1.- totfrac_nobio(:)666 snowa_veg(:) = 0.668 fraction_veg(:) = un - totfrac_nobio(:) 669 snowa_veg(:) = zero 667 670 DO jv = 1, nvm 668 671 DO ji = 1, kjpindex … … 1112 1115 ENDDO 1113 1116 ! 1114 WHERE ( sumveg(:) .GT. 0.0) z0(:) = z0(:) / sumveg(:)1117 WHERE ( sumveg(:) .GT. zero ) z0(:) = z0(:) / sumveg(:) 1115 1118 ! 1116 1119 z0(:) = (un - totfrac_nobio(:)) * z0(:) … … 1166 1169 ! 1167 1170 !!$ DS :Correction 11/02/2011 : update 2D parameters 1168 !!$ before the components were updated but not the parameter itself!1169 1171 alb_leaf(1:nvm) = alb_leaf_vis(:) 1170 1172 alb_leaf(nvm+1:2*nvm) = alb_leaf_nir(:) 1171 !!$ maybe we could use directly alb_leaf_vis and alb_leaf_nir in alb_leaf_temp1172 !1173 !!$ alb_leaf_tmp(:,1) = alb_leaf_vis(:)1174 !!$ alb_leaf_tmp(:,2) = alb_leaf_nir(:)1175 1173 ! 1176 1174 alb_leaf_tmp(:,1) = alb_leaf(1:nvm) … … 1188 1186 ! 1189 1187 ! Correction Nathalie le 12 Avril 2006 - suppression de la dependance en deadleaf_cover 1190 !albedo(:,ks) = veget(:,1) * ( ( 1.-deadleaf_cover(:))*alb_bare(:) + &1188 !albedo(:,ks) = veget(:,1) * ( (un-deadleaf_cover(:))*alb_bare(:) + & 1191 1189 ! deadleaf_cover(:)*alb_deadleaf(ks) ) 1192 1190 albedo(:,ks) = veget(:,1) * alb_bare(:,ks) -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/diffuco.f90
r105 r257 3 3 !! 4 4 !! @author Marie-Alice Foujols and Jan Polcher 5 !! @Version : $Revision: 1.35 $, $Date: 2010/04/07 09:16:40$5 !! @Version : $Revision: 42 $, $Date: 2011-01-01 21:15:03 +0100 (Sat, 01 Jan 2011) $ 6 6 !! 7 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/diffuco.f90,v 1.35 2010/04/07 09:16:40 ssipsl Exp $ 7 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/diffuco.f90 $ 8 !< $Date: 2011-01-01 21:15:03 +0100 (Sat, 01 Jan 2011) $ 9 !< $Author: mmaipsl $ 10 !< $Revision: 42 $ 8 11 !! IPSL (2006) 9 12 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 38 41 !! Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout 39 42 !! d'un potentiometre pour regler la resistance de la vegetation ( rveg is now in pft_parameters) 40 41 43 ! MM 42 44 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: wind !! Wind norm … … 242 244 ! beta coefficient for bare soil 243 245 ! 244 245 246 CALL diffuco_bare (kjpindex, dtradia, u, v, q_cdrag, rsol, evap_bare_lim, evapot, humrel, veget, vbeta4) 246 247 … … 744 745 IF ( zrapp .LT. un ) THEN 745 746 ! Ajout Nathalie - Juin 2006 746 vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, 0.)747 vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, zero) 747 748 ! Fin ajout Nathalie 748 749 vbeta2(ji,jv) = vbeta2(ji,jv) * zrapp … … 1004 1005 ! 1005 1006 DO jl = 1, nlai+1 1006 laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))- 1.)1007 laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-un) 1007 1008 ENDDO 1008 1009 ! … … 1100 1101 ! 1101 1102 WHERE ( assimilate(:) ) 1102 water_lim(:) = MIN( 2.*humrel(:,jv), 1.)1103 water_lim(:) = MIN( 2.*humrel(:,jv), un ) 1103 1104 ENDWHERE 1104 1105 ! give a default value of ci for all pixel that do not assimilate … … 1255 1256 DO ji = 1, kjpindex 1256 1257 ! 1257 assimi(ji) = 0.1258 assimi(ji) = zero 1258 1259 ! 1259 1260 ENDDO … … 1288 1289 DO ji = 1, kjpindex 1289 1290 ! 1290 assimi(ji) = 0.1291 assimi(ji) = zero 1291 1292 ! 1292 1293 ENDDO … … 1383 1384 IF ( jl .EQ. 1 ) THEN 1384 1385 ! 1385 leaf_gs_top(:) = 0.1386 leaf_gs_top(:) = zero 1386 1387 ! 1387 1388 IF ( nic .GT. 0 ) then … … 1437 1438 laitab(ilai(iainia)+1) 1438 1439 ! 1439 rveget(iainia,jv) = 1./gstop(iainia)1440 rveget(iainia,jv) = un/gstop(iainia) 1440 1441 ! 1441 1442 ENDDO … … 1448 1449 ! 1449 1450 ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif 1450 !rstruct(iainia,jv) = 1./gstot(iainia) - &1451 !rstruct(iainia,jv) = un/gstot(iainia) - & 1451 1452 ! rveget(iainia,jv) 1452 rstruct(iainia,jv) = MAX( 1./gstot(iainia) - &1453 rstruct(iainia,jv) = MAX( un/gstot(iainia) - & 1453 1454 rveget(iainia,jv), min_sechiba) 1454 1455 ! … … 1556 1557 REAL(r_std) :: coeff_dew_veg 1557 1558 1558 vbeta2sum(:) = 0.1559 vbeta3sum(:) = 0.1559 vbeta2sum(:) = zero 1560 vbeta3sum(:) = zero 1560 1561 DO jv = 1, nvm 1561 1562 vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv) … … 1593 1594 1594 1595 ! for vectorization: some arrays 1595 vegetsum(:) = 0.1596 vegetsum(:) = zero 1596 1597 DO jv = 1, nvm 1597 1598 vegetsum(:) = vegetsum(:) + veget(:,jv) 1598 1599 ENDDO 1599 vegetsum2(:) = 0.1600 vegetsum2(:) = zero 1600 1601 DO jv = 2, nvm 1601 1602 vegetsum2(:) = vegetsum2(:) + veget(:,jv) … … 1667 1668 & + dew_veg_poly_coeff(2)*lai(ji,jv) & 1668 1669 & + dew_veg_poly_coeff(1) 1669 1670 1671 1670 ELSE 1672 coeff_dew_veg= 1.1671 coeff_dew_veg=un 1673 1672 ENDIF 1674 1673 ELSE -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/enerbil.f90
r113 r257 3 3 !! 4 4 !! @author Marie-Alice Foujols and Jan Polcher 5 !! @Version : $Revision: 1.24 $, $Date: 2009/01/07 13:39:45$5 !! @Version : $Revision: 47 $, $Date: 2011-01-01 21:34:45 +0100 (Sat, 01 Jan 2011) $ 6 6 !! 7 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/enerbil.f90,v 1.24 2009/01/07 13:39:45 ssipsl Exp $ 7 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/enerbil.f90 $ 8 !< $Date: 2011-01-01 21:34:45 +0100 (Sat, 01 Jan 2011) $ 9 !< $Author: mmaipsl $ 10 !< $Revision: 47 $ 8 11 !! IPSL (2006) 9 12 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 121 124 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: evapot !! Soil Potential Evaporation 122 125 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: evapot_corr !! Soil Potential Evaporation Correction 126 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol !! Soil temperature 127 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: qsurf !! Surface specific humidity 128 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: fluxsens !! Sensible chaleur flux 129 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: fluxlat !! Latent chaleur flux 130 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: tsol_rad !! Tsol_rad 131 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapp !! Total of evaporation 132 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: gpp !! Assimilation, gC/m**2 total area. 133 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_new !! New soil temperature 123 134 ! output fields 124 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: fluxsens !! Sensible chaleur flux125 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: fluxlat !! Latent chaleur flux126 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: vevapp !! Total of evaporation127 135 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: vevapnu !! Bare soil evaporation 128 136 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: vevapsno !! Snow evaporation 129 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tsol_rad !! Tsol_rad130 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_sol_new !! New soil temperature131 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_sol !! Soil temperature132 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: qsurf !! Surface specific humidity133 137 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: transpir !! Transpiration 134 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: gpp !! Assimilation, gC/m**2 total area.135 138 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vevapwet !! Interception 136 139 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: t2mdiag !! 2-meter temperature … … 281 284 ! output fields, they need to initialized somehow for the model forcing ORCHIDEE. 282 285 ! 283 REAL(r_std),DIMENSION (kjpindex), INTENT ( out):: temp_sol !! Soil temperature286 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol !! Soil temperature 284 287 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_sol_new !! New soil temperature 285 288 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: qsurf !! near surface specific humidity … … 423 426 !Config the model is started without a restart file. 424 427 ! 425 CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', 0.0_r_std)428 CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', zero) 426 429 IF ( ok_var("evapot_corr") ) THEN 427 CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', 0.0_r_std)430 CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', zero) 428 431 ENDIF 429 432 ! … … 778 781 REAL(r_std) :: correction 779 782 REAL(r_std) :: speed, qc 783 LOGICAL,DIMENSION (kjpindex) :: warning_correction 780 784 ! initialisation 781 785 … … 840 844 ! grad_qsat(:)= (qsol_sat_new(:)- qsat_air(:)) / ((psnew(:) - epot_air(:)) / cp_air) ! * dtradia 841 845 !- Penser a sortir evapot en meme temps qu'evapot_corr tdo. 846 warning_correction(:)=.FALSE. 842 847 DO ji=1,kjpindex 843 848 … … 852 857 correction = chalev0 * rau(ji) * qc * grad_qsat(ji) * (un - vevapp(ji)/evapot(ji)) / correction 853 858 ELSE 854 WRITE(numout,*) "Denominateur de la correction de milly nul! Aucune correction appliquee"859 warning_correction(ji)=.TRUE. 855 860 ENDIF 856 861 ELSE … … 862 867 863 868 ENDDO 864 869 IF ( ANY(warning_correction) ) THEN 870 DO ji=1,kjpindex 871 IF ( warning_correction(ji) ) THEN 872 WRITE(numout,*) ji,"Denominateur de la correction de milly nul! Aucune correction appliquee" 873 ENDIF 874 ENDDO 875 ENDIF 865 876 IF (long_print) WRITE (numout,*) ' enerbil_flux done ' 866 877 … … 886 897 REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot !! Soil Potential Evaporation 887 898 REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in) :: humrel !! Relative humidity 888 !!$ DS 15022011 humrel was used in a previ uos version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduces again899 !!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduces again 889 900 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vbeta2 !! Interception resistance 890 901 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vbeta3 !! Vegetation resistance … … 969 980 ELSEIF ( control%stomate_watchout ) THEN 970 981 971 gpp(:,:) = 0.0982 gpp(:,:) = zero 972 983 973 984 ENDIF … … 1001 1012 1002 1013 ! initialisation 1003 IF (long_print) WRITE (numout,*) ' enerbil_fusion start ', MINVAL(soilcap), MINLOC(soilcap),&1014 IF (long_print) WRITE (numout,*) ' enerbil_fusion start ', MINVAL(soilcap), MINLOC(soilcap),& 1004 1015 & MAXVAL(soilcap), MAXLOC(soilcap) 1005 1016 ! -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/hydrol.f90
r112 r257 3 3 !! 4 4 !! @author Marie-Alice Foujols and Jan Polcher 5 !! @Version : $Revision: 1.36 $, $Date: 2009/01/07 13:39:45$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/hydrol.f90,v 1.36 2009/01/07 13:39:45 ssipsl Exp $ 7 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/hydrol.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 … … 224 227 !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency. 225 228 !! The water balance is limite to + or - 10^6 so that accumulation is not endless 229 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: runoff !! Complete runoff 230 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: drainage !! Drainage 231 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout):: shumdiag !! relative soil moisture 226 232 ! output fields 227 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: runoff !! Complete runoff228 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drainage !! Drainage229 233 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity 230 234 REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth) 231 235 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness 232 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag !! relative soil moisture233 236 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity 234 237 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_melt !! Total melt … … 1082 1085 ! 1083 1086 DO jsl=1,nslm 1084 CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', 0.0_r_std)1087 CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero) 1085 1088 ENDDO 1086 1089 ! … … 1101 1104 !Config started without a restart file. 1102 1105 ! 1103 CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', 0.0_r_std)1106 CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero) 1104 1107 ! 1105 1108 !Config Key = HYDROL_SNOW … … 1110 1113 !Config started without a restart file. 1111 1114 ! 1112 CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', 0.0_r_std)1115 CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero) 1113 1116 ! 1114 1117 !Config Key = HYDROL_SNOWAGE … … 1119 1122 !Config started without a restart file. 1120 1123 ! 1121 CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', 0.0_r_std)1124 CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero) 1122 1125 ! 1123 1126 !Config Key = HYDROL_SNOW_NOBIO … … 1128 1131 !Config started without a restart file. 1129 1132 ! 1130 CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', 0.0_r_std)1133 CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero) 1131 1134 ! 1132 1135 !Config Key = HYDROL_SNOW_NOBIO_AGE … … 1137 1140 !Config started without a restart file. 1138 1141 ! 1139 CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', 0.0_r_std)1142 CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero) 1140 1143 ! 1141 1144 ! … … 1148 1151 !Config the model is started without a restart file. 1149 1152 ! 1150 CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', 0.0_r_std)1153 CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero) 1151 1154 ! 1152 1155 ! There is no need to configure the initialisation of resdist. If not available it is the vegetation map … … 1717 1720 IF (snow(ji).GT.sneige) THEN 1718 1721 ! 1719 snowmelt(ji) = ( 1.- frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu01722 snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0 1720 1723 ! 1721 1724 ! 1.3.1.1 enough snow for melting or not … … 1890 1893 REAL(r_std), DIMENSION (kjpindex,nvm) :: zqsintvegnew 1891 1894 LOGICAL, SAVE :: firstcall=.TRUE. 1892 ! REAL(r_std), SAVE, DIMENSION(nvm) :: throughfall_by_pft1893 1895 1894 1896 IF ( firstcall ) THEN … … 2078 2080 DO jv = 1, nvm 2079 2081 DO ji = 1, kjpindex 2080 IF ( ABS(qsintveg(ji,jv)) > 0..AND. ABS(qsintveg(ji,jv)) < EPS1 ) THEN2082 IF ( ABS(qsintveg(ji,jv)) > zero .AND. ABS(qsintveg(ji,jv)) < EPS1 ) THEN 2081 2083 qsintveg(ji,jv) = EPS1 2082 2084 ENDIF -
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 -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90
r116 r257 7 7 !! 8 8 !! @call sechiba_main 9 !! @Version : $Revision: 1.85 $, $Date: 2010/07/29 15:58:19$9 !! @Version : $Revision: 221 $, $Date: 2011-05-16 17:26:17 +0200 (Mon, 16 May 2011) $ 10 10 !! 11 11 !! @author Marie-Alice Foujols and Jan Polcher 12 12 !! 13 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/intersurf.f90,v 1.85 2010/07/29 15:58:19 ssipsl Exp $ 13 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/intersurf.f90 $ 14 !< $Date: 2011-05-16 17:26:17 +0200 (Mon, 16 May 2011) $ 15 !< $Author: martial.mancip $ 16 !< $Revision: 221 $ 14 17 !! IPSL (2006) 15 18 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 181 184 ! 182 185 CALL ipslnlf(new_number=numout,old_number=old_fileout) 183 184 186 ! 185 187 IF (l_first_intersurf) THEN … … 225 227 IF ( ok_watchout ) THEN 226 228 IF (is_root_prc) THEN 227 zlev_mean = 0.229 zlev_mean = zero 228 230 DO ik=1, nbp_glo 229 231 j = ((index_g(ik)-1)/iim_g) + 1 … … 391 393 !!$ dt_split_watch,dt_watch,one_day 392 394 !!$ CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang) 393 !!$ WHERE ( sinang(:,:) .LT. EPSILON( 1.) )395 !!$ WHERE ( sinang(:,:) .LT. EPSILON(un) ) 394 396 !!$ isinang(:,:) = isinang(:,:) - 1 395 397 !!$ ENDWHERE … … 529 531 CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex) 530 532 ! 531 CALL histwrite (hist_id, 'temp_sol', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)532 CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)533 CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)534 CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)535 CALL histwrite (hist_id, 'fluxlat', itau_sechiba, fluxlat, iim*jjm, kindex)536 CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)537 CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)538 CALL histwrite (hist_id, 'alb_vis', itau_sechiba, albedo(:,:,1), iim*jjm, kindex)539 CALL histwrite (hist_id, 'alb_nir', itau_sechiba, albedo(:,:,2), iim*jjm, kindex)540 CALL histwrite (hist_id, 'tair', itau_sechiba, temp_air, iim*jjm, kindex)541 CALL histwrite (hist_id, 'qair', itau_sechiba, qair, iim*jjm, kindex)533 CALL histwrite (hist_id, 'temp_sol', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 534 CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 535 CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 536 CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex) 537 CALL histwrite (hist_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex) 538 CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, kjpindex, kindex) 539 CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, kjpindex, kindex) 540 CALL histwrite (hist_id, 'alb_vis', itau_sechiba, albedo(:,:,1), kjpindex, kindex) 541 CALL histwrite (hist_id, 'alb_nir', itau_sechiba, albedo(:,:,2), kjpindex, kindex) 542 CALL histwrite (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex) 543 CALL histwrite (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex) 542 544 ! Ajout Nathalie - Juin 2006 - on conserve q2m/t2m 543 CALL histwrite (hist_id, 'q2m', itau_sechiba, qair, iim*jjm, kindex)544 CALL histwrite (hist_id, 't2m', itau_sechiba, temp_air, iim*jjm, kindex)545 CALL histwrite (hist_id, 'q2m', itau_sechiba, qair, kjpindex, kindex) 546 CALL histwrite (hist_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex) 545 547 IF ( hist2_id > 0 ) THEN 546 548 CALL histwrite (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex) … … 548 550 CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex) 549 551 ! 550 CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)551 CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)552 CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)553 CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)554 CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, fluxlat, iim*jjm, kindex)555 CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)556 CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)557 CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, albedo(:,:,1), iim*jjm, kindex)558 CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, albedo(:,:,2), iim*jjm, kindex)559 CALL histwrite (hist2_id, 'tair', itau_sechiba, temp_air, iim*jjm, kindex)560 CALL histwrite (hist2_id, 'qair', itau_sechiba, qair, iim*jjm, kindex)561 CALL histwrite (hist2_id, 'q2m', itau_sechiba, qair, iim*jjm, kindex)562 CALL histwrite (hist2_id, 't2m', itau_sechiba, temp_air, iim*jjm, kindex)552 CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 553 CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 554 CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 555 CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex) 556 CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex) 557 CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, kjpindex, kindex) 558 CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, kjpindex, kindex) 559 CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, albedo(:,:,1), kjpindex, kindex) 560 CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, albedo(:,:,2), kjpindex, kindex) 561 CALL histwrite (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex) 562 CALL histwrite (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex) 563 CALL histwrite (hist2_id, 'q2m', itau_sechiba, qair, kjpindex, kindex) 564 CALL histwrite (hist2_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex) 563 565 ENDIF 564 566 ELSE 565 567 CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex) 566 CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)567 CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)568 CALL histwrite (hist_id, 'Qle', itau_sechiba, fluxlat, iim*jjm, kindex)569 CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)570 CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)568 CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, kjpindex, kindex) 569 CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex) 570 CALL histwrite (hist_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex) 571 CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 572 CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 571 573 IF ( hist2_id > 0 ) THEN 572 574 CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex) 573 CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)574 CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)575 CALL histwrite (hist2_id, 'Qle', itau_sechiba, fluxlat, iim*jjm, kindex)576 CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)577 CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)575 CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, kjpindex, kindex) 576 CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex) 577 CALL histwrite (hist2_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex) 578 CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 579 CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex) 578 580 ENDIF 579 581 ENDIF … … 780 782 ! 781 783 IF ( ok_watchout ) THEN 782 zlev_mean = 0.784 zlev_mean = zero 783 785 DO ik=1, kjpindex 784 786 … … 905 907 !!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day 906 908 !!$ CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang) 907 !!$ WHERE ( sinang(:,:) .LT. EPSILON( 1.) )909 !!$ WHERE ( sinang(:,:) .LT. EPSILON(un) ) 908 910 !!$ isinang(:,:) = isinang(:,:) - 1 909 911 !!$ ENDWHERE … … 1448 1450 IF ( ok_watchout ) THEN 1449 1451 IF (is_root_prc) THEN 1450 zlev_mean = 0.1452 zlev_mean = zero 1451 1453 DO ik=1, nbp_glo 1452 1454 j = ((index_g(ik)-1)/iim_g) + 1 … … 1602 1604 !!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day 1603 1605 !!$ CALL solarang (julian_watch, julian0, iim, jjm, tmp_lon, tmp_lat, sinang) 1604 !!$ WHERE ( sinang(:,:) .LT. EPSILON( 1.) )1606 !!$ WHERE ( sinang(:,:) .LT. EPSILON(un) ) 1605 1607 !!$ isinang(:,:) = isinang(:,:) - 1 1606 1608 !!$ ENDWHERE … … 2178 2180 IF ( ok_watchout ) THEN 2179 2181 IF (is_root_prc) THEN 2180 zlev_mean = 0.2182 zlev_mean = zero 2181 2183 DO ik=1, nbp_glo 2182 2184 j = ((index_g(ik)-1)/iim_g) + 1 … … 2332 2334 !!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day 2333 2335 !!$ CALL solarang (julian_watch, julian0, iim, jjm, tmp_lon, tmp_lat, sinang) 2334 !!$ WHERE ( sinang(:,:) .LT. EPSILON( 1.) )2336 !!$ WHERE ( sinang(:,:) .LT. EPSILON(un) ) 2335 2337 !!$ isinang(:,:) = isinang(:,:) - 1 2336 2338 !!$ ENDWHERE … … 2586 2588 CALL tlen2itau('1Y',dt,date0,year_length) 2587 2589 IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN 2588 year_spread= 1.02590 year_spread=un 2589 2591 ELSE 2590 2592 year_spread = one_year/365.2425 … … 2610 2612 ! Real date 2611 2613 CALL ju2ymds (in_julian, year, month, day, sec) 2612 !!$ jur= 0.2614 !!$ jur=zero 2613 2615 !!$ julian_diff = in_julian 2614 2616 !!$ month_len = ioget_mon_len (year,month) … … 2630 2632 ENDIF 2631 2633 ELSE 2632 !!$ in_julian = itau2date(istp-1, 0., dt)2634 !!$ in_julian = itau2date(istp-1, zero, dt) 2633 2635 !!$ CALL ju2ymds (in_julian, year, month, day, sec) 2634 !!$ jur= 0.2636 !!$ jur=zero 2635 2637 !!$ julian_diff = in_julian 2636 2638 !!$ month_len = ioget_mon_len (year,month) … … 2693 2695 CALL getin_p('NVM',nvm) 2694 2696 WRITE(numout,*)'the number of pfts is : ', nvm 2695 !!$DS Debug 28/01/20112696 2697 ! 2697 2698 !Config Key = LONGPRINT … … 2723 2724 ! 2724 2725 dt_watch = dt 2725 CALL getin ('DT_WATCHOUT',dt_watch)2726 CALL getin_p('DT_WATCHOUT',dt_watch) 2726 2727 dt_split_watch = dt_watch / dt 2727 2728 ! … … 2740 2741 ENDIF 2741 2742 2742 2743 2743 !!$ DS : reading of IMPOSE_PARAM 2744 2744 ! Option : do you want to change the values of the parameters 2745 2745 CALL getin_p('IMPOSE_PARAM',impose_param) 2746 ! Calling pft_parameters2747 2746 CALL pft_parameters_main 2748 2747 ! … … 2784 2783 IF ( control_flags%hydrol_cwrr ) THEN 2785 2784 CALL getin_hydrol_cwrr_parameters 2785 ELSE 2786 CALL getin_hydrolc_parameters 2787 ! we read the parameters for the choisnel hydrology 2786 2788 ENDIF 2787 2789 … … 2800 2802 CALL getin_co2_parameters 2801 2803 ENDIF 2802 2803 2804 2805 !!$ DS : reading of IMPOSE_PARAM2806 !!$ ! Option : do you want to change the values of the parameters2807 !!$ CALL getin_p('IMPOS_PARAM',impos_param)2808 !!$ ! Calling pft_parameters2809 !!$ CALL pft_main2810 2804 2811 2805 ! … … 2844 2838 WRITE(numout,*) 'It is not possible because it has to be modified ', & 2845 2839 ' to give correct values.' 2846 CALL ipslerr ( 3,'intsurf_config', &2847 & 'Use of STOMATE_OK_DGVM not allowed withthis version.',&2848 & 'ORCHIDEE will stop.', &2840 CALL ipslerr (2,'intsurf_config', & 2841 & 'Use of STOMATE_OK_DGVM is not stable for this version.',& 2842 & 'ORCHIDEE should not give correct results with this option activated.', & 2849 2843 & 'Please disable DGVM to use this version of ORCHIDEE.') 2850 2844 ENDIF … … 2965 2959 CALL getin_p('SECHIBA_reset_time', overwrite_time) 2966 2960 ! 2967 lev(:) = 0.2961 lev(:) = zero 2968 2962 itau_dep = istp 2969 2963 in_julian = itau2date(istp, date0, dt) … … 3186 3180 !Config Key = WRITE_STEP 3187 3181 !Config Desc = Frequency in seconds at which to WRITE output 3188 !Config Def = 86400.03182 !Config Def = one_day 3189 3183 !Config Help = This variables gives the frequency the output of 3190 3184 !Config the model should be written into the netCDF file. … … 3198 3192 ! 3199 3193 veg(1:nvm) = (/ (REAL(i,r_std),i=1,nvm) /) 3200 !$$ DS DEBUG3201 WRITE(numout,*)'nvm : = ', nvm3202 WRITE(numout,*)'veg : =', veg3203 !$$ nvm =13 (put the calling to getin before)3204 3194 sol(1:ngrnd) = (/ (REAL(i,r_std),i=1,ngrnd) /) 3205 3195 soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /) … … 3216 3206 WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt 3217 3207 !WRITE(flux_sc,'("(ave(X)*",F8.1,")")') one_day/dt 3218 WRITE(flux_insec,'("ave(X*",F8.6,")")') 1.0/dt3219 WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') 1.0/dt3208 WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt 3209 WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') un/dt 3220 3210 WRITE(numout,*) flux_op, one_day/dt, dt, dw 3221 3211 !- … … 3371 3361 & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw) 3372 3362 ENDIF 3373 IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN3374 CALL histdef (hist_id,'CO2FLUX','Total output CO2 flux', 'gC/day/(m^2 tot)', &3375 & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt, dw)3376 ENDIF3377 3363 !- 3378 3364 !- SECHIBA_HISTLEVEL = 2 … … 3692 3678 CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', & 3693 3679 & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw) 3694 IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN3695 ! Total output CO2 flux3696 CALL histdef (hist_id,'CO2FLUX','Total output CO2 flux', 'gC/day/(m^2 tot)', &3697 & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt, dw)3698 ENDIF3699 3680 !- 3700 3681 !- General energy balance … … 4033 4014 CALL histdef(hist2_id, 'emis', 'Surface emissivity', '?', & 4034 4015 & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2) 4035 IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN4036 CALL histdef (hist2_id,'CO2FLUX','Total output CO2 flux', 'gC/day/(m^2 tot)', &4037 & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(2), dt, dw2)4038 ENDIF4039 4016 !- 4040 4017 !- SECHIBA_HISTLEVEL2 = 3 … … 4298 4275 CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', & 4299 4276 & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(3), dt, dw2) 4300 IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN4301 CALL histdef (hist2_id,'CO2FLUX','Total output CO2 flux', 'gC/day/(m^2 tot)', &4302 & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt, dw2)4303 ENDIF4304 4277 !- 4305 4278 !- General energy balance … … 4465 4438 hist_days_stom = 10. 4466 4439 CALL getin_p('STOMATE_HIST_DT', hist_days_stom) 4467 IF ( hist_days_stom == -1.) THEN4468 hist_dt_stom = -1.4440 IF ( hist_days_stom == moins_un ) THEN 4441 hist_dt_stom = moins_un 4469 4442 WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.' 4470 4443 ELSE … … 4477 4450 dt_slow_ = one_day 4478 4451 CALL getin_p('DT_SLOW', dt_slow_) 4479 IF ( hist_days_stom /= -1.) THEN4452 IF ( hist_days_stom /= moins_un ) THEN 4480 4453 IF (dt_slow_ > hist_dt_stom) THEN 4481 4454 WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_HIST_DT = ",hist_dt_stom … … 4567 4540 !Config Help = Time step of the STOMATE IPCC history file 4568 4541 !- 4569 hist_days_stom_ipcc = 0.4542 hist_days_stom_ipcc = zero 4570 4543 CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc) 4571 IF ( hist_days_stom_ipcc == -1.) THEN4572 hist_dt_stom_ipcc = -1.4544 IF ( hist_days_stom_ipcc == moins_un ) THEN 4545 hist_dt_stom_ipcc = moins_un 4573 4546 WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.' 4574 4547 ELSE … … 4581 4554 dt_slow_ = one_day 4582 4555 CALL getin_p('DT_SLOW', dt_slow_) 4583 IF ( hist_days_stom_ipcc > 0.) THEN4556 IF ( hist_days_stom_ipcc > zero ) THEN 4584 4557 IF (dt_slow_ > hist_dt_stom_ipcc) THEN 4585 4558 WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc … … 4822 4795 & 1,1,1, -99,32, ave(5), dt, hist_dt) 4823 4796 4824 ! MonthlyCO2 flux4825 CALL histdef (hist_id_stom, & 4826 & TRIM("CO2FLUX _MONTHLY"), &4827 & TRIM(" Monthly CO2 flux"), &4797 ! CO2 flux 4798 CALL histdef (hist_id_stom, & 4799 & TRIM("CO2FLUX "), & 4800 & TRIM("CO2 flux "), & 4828 4801 & TRIM("gC/m^2/pft/mth "), iim,jjm, hist_hori_id, & 4829 4802 & nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt) 4830 4803 4831 CALL histdef(hist_id_stom, &4832 & TRIM("CO2FLUX_MONTHLY_SUM "), &4833 & TRIM("Monthly CO2 flux"), &4834 & TRIM("PgC/m^2/mth "), 1,1, hist_hori_id, &4835 & 1,1,1, -99, 32, ave(1), dt, hist_dt)4804 !!$ CALL histdef(hist_id_stom, & 4805 !!$ & TRIM("CO2FLUX_MONTHLY_SUM "), & 4806 !!$ & TRIM("Monthly CO2 flux Sum "), & 4807 !!$ & TRIM("PgC/m^2/mth "), iim,jjm, hist_hori_id, & 4808 !!$ & 1,1,1, -99, 32, 'inst(scatter(X))', dt, hist_dt) 4836 4809 4837 4810 ! Output CO2 flux from fire … … 5121 5094 & TRIM("1/day "), iim,jjm, hist_hori_id, & 5122 5095 & nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt) 5096 5097 ! Establish tree 5098 CALL histdef (hist_id_stom, & 5099 & TRIM("ESTABTREE "), & 5100 & TRIM("Rate of tree establishement "), & 5101 & TRIM("1/day "), iim,jjm, hist_hori_id, & 5102 & 1,1,1, -99,32, ave(6), dt, hist_dt) 5103 5104 ! Establish grass 5105 CALL histdef (hist_id_stom, & 5106 & TRIM("ESTABGRASS "), & 5107 & TRIM("Rate of grass establishement "), & 5108 & TRIM("1/day "), iim,jjm, hist_hori_id, & 5109 & 1,1,1, -99,32, ave(6), dt, hist_dt) 5123 5110 5124 5111 ! Fraction of plants that dies (light competition) -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba.f90
r142 r257 4 4 !! 5 5 !! @author Marie-Alice Foujols and Jan Polcher 6 !! @Version : $Revision: 1.46 $, $Date: 2010/05/07 08:28:13$6 !! @Version : $Revision: 45 $, $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 7 7 !! 8 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/sechiba.f90,v 1.46 2010/05/07 08:28:13 ssipsl Exp $ 8 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/sechiba.f90 $ 9 !< $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 10 !< $Author: mmaipsl $ 11 !< $Revision: 45 $ 9 12 !! IPSL (2006) 10 13 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 239 242 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tsol_rad !! Radiative surface temperature 240 243 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: vevapp !! Total of evaporation 241 REAL(r_std),DIMENSION (kjpindex), INTENT ( out) :: temp_sol_new !! New soil temperature244 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_new !! New soil temperature 242 245 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: qsurf_out !! Surface specific humidity 243 246 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: z0_out !! Surface roughness (output diagnostic) … … 256 259 REAL(r_std), DIMENSION(kjpindex) :: sum_treefrac, sum_grassfrac, sum_cropfrac 257 260 INTEGER(i_std) :: jv 258 259 260 261 261 262 262 IF (long_print) WRITE(numout,*) ' kjpindex =',kjpindex … … 636 636 ENDIF 637 637 638 histvar(:)=SUM(vevapwet(:,:),dim=2)/ 86400638 histvar(:)=SUM(vevapwet(:,:),dim=2)/one_day 639 639 CALL histwrite(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index) 640 640 641 histvar(:)=(vevapnu(:)+vevapsno(:))/ 86400641 histvar(:)=(vevapnu(:)+vevapsno(:))/one_day 642 642 CALL histwrite(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index) 643 643 644 histvar(:)=SUM(transpir(:,:),dim=2)/ 86400644 histvar(:)=SUM(transpir(:,:),dim=2)/one_day 645 645 CALL histwrite(hist_id, 'tran', kjit, histvar, kjpindex, index) 646 647 !------------------------------------648 649 ! histvar(:)=SUM(veget_max(:,2:9),dim=2)*100*contfrac(:)650 ! CALL histwrite(hist_id, 'treeFrac', kjit, histvar, kjpindex, index)651 652 ! histvar(:)=SUM(veget_max(:,10:11),dim=2)*100*contfrac(:)653 ! CALL histwrite(hist_id, 'grassFrac', kjit, histvar, kjpindex, index)654 655 ! histvar(:)=SUM(veget_max(:,12:13),dim=2)*100*contfrac(:)656 ! CALL histwrite(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)657 646 658 647 !$$ 25/10/10 Modif DS & NViovy … … 666 655 histvar(:)= sum_cropfrac(:)*100*contfrac(:) 667 656 CALL histwrite(hist_id, 'cropFrac', kjit, histvar, kjpindex, index) 668 669 657 670 658 histvar(:)=veget_max(:,1)*100*contfrac(:) … … 1347 1335 ENDDO 1348 1336 1349 1350 1337 ! 1351 1338 ! 2. restart value … … 1372 1359 ! 1373 1360 1361 control%river_routing = control_in%river_routing 1362 control%hydrol_cwrr = control_in%hydrol_cwrr 1374 1363 control%ok_co2 = control_in%ok_co2 1375 1364 control%ok_sechiba = control_in%ok_sechiba -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba_io.f90
r64 r257 10 10 !! 11 11 !! @author Marie-Alice Foujols and Jan Polcher 12 !! @Version : $Revision: 1 .8 $, $Date: 2008/03/21 13:56:12$12 !! @Version : $Revision: 12 $, $Date: 2010-11-05 16:42:13 +0100 (Fri, 05 Nov 2010) $ 13 13 !! 14 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/sechiba_io.f90,v 1.8 2008/03/21 13:56:12 ssipsl Exp $ 14 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/sechiba_io.f90 $ 15 !< $Date: 2010-11-05 16:42:13 +0100 (Fri, 05 Nov 2010) $ 16 !< $Author: mmaipsl $ 17 !< $Revision: 12 $ 15 18 !! IPSL (2006) 16 19 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba_io_p.f90
r64 r257 10 10 !! 11 11 !! @author Marie-Alice Foujols and Jan Polcher 12 !! @Version : $Revision: 1 .4 $, $Date: 2008/03/21 13:56:12$12 !! @Version : $Revision: 12 $, $Date: 2010-11-05 16:42:13 +0100 (Fri, 05 Nov 2010) $ 13 13 !! 14 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/sechiba_io_p.f90,v 1.4 2008/03/21 13:56:12 ssipsl Exp $ 14 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/sechiba_io_p.f90 $ 15 !< $Date: 2010-11-05 16:42:13 +0100 (Fri, 05 Nov 2010) $ 16 !< $Author: mmaipsl $ 17 !< $Revision: 12 $ 15 18 !! IPSL (2006) 16 19 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/slowproc.f90
r143 r257 2 2 ! Daily update of leaf area index etc. 3 3 ! 4 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/slowproc.f90,v 1.48 2010/04/20 14:12:04 ssipsl Exp $ 4 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/slowproc.f90 $ 5 !< $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 6 !< $Author: mmaipsl $ 7 !< $Revision: 45 $ 5 8 !! IPSL (2006) 6 9 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 54 57 LOGICAL, SAVE :: old_lai = .FALSE. ! Old Lai Map interpolation 55 58 LOGICAL, SAVE :: impveg = .FALSE. 59 LOGICAL, SAVE :: impsoilt = .FALSE. 56 60 LOGICAL, SAVE :: old_veget = .FALSE. ! Old veget Map interpolation 57 61 ! … … 143 147 LOGICAL, PARAMETER :: check = .FALSE. 144 148 145 REAL(r_std), SAVE :: sec_old = 0.149 REAL(r_std), SAVE :: sec_old = zero 146 150 ! 147 151 ! do initialisation … … 299 303 ! Test each day and assert all slow processes (days and years) 300 304 ! 301 IF ( sec_old >= one_day - dtradia .AND. sec >= 0.) THEN305 IF ( sec_old >= one_day - dtradia .AND. sec >= zero ) THEN 302 306 ! 303 307 ! reset counter … … 510 514 LOGICAL, PARAMETER :: check = .FALSE. 511 515 ! 512 ! DS 15032011 add for replacing SUM(veget_max(ji,nvm-1:nvm 516 ! DS 15032011 add for replacing SUM(veget_max(ji,nvm-1:nvm)) 513 517 REAL(r_std) :: sum_veget_max 514 !515 516 518 517 519 ! … … 582 584 !Config only done once a day. 583 585 ! 584 CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', 0.0_r_std)586 CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', zero) 585 587 ! 586 588 !Config Key = LAI_MAP … … 733 735 CALL restget_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, .TRUE., laimap) 734 736 ! 737 ELSE 738 ! 739 ALLOCATE (laimap(1,1,1)) 735 740 ENDIF 736 741 ! … … 806 811 !Config Key = DT_SLOW 807 812 !Config Desc = Time step of STOMATE and other slow processes 808 !Config Def = 86400.813 !Config Def = one_day 809 814 !Config Help = Time step (s) of regular update of vegetation 810 815 !Config cover, LAI etc. This is also the time step … … 905 910 CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax) 906 911 907 908 !Config Key = SOIL_FRACTIONS909 !Config Desc = Fraction of the 3 soil types (0-dim mode)910 !Config Def = 0.28, 0.52, 0.20912 ! 913 !Config Key = IMPOSE_SOILT 914 !Config Desc = Should the soil typ be prescribed 915 !Config Def = n 911 916 !Config If = IMPOSE_VEG 912 !Config Help = Determines the fraction for the 3 soil types 913 !Config in the mesh in the following order : sand loam and clay. 914 ! 915 CALL setvar_p (soiltype, val_exp, 'SOIL_FRACTIONS', soiltype_default) 916 917 918 !Config Key = CLAY_FRACTION 919 !Config Desc = Fraction of the clay fraction (0-dim mode) 920 !Config Def = 0.2 921 !Config If = IMPOSE_VEG 922 !Config Help = Determines the fraction of clay in the grid box. 923 ! 924 CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default) 925 917 !Config Help = This flag allows the user to impose a soil type distribution. 918 !Config It is espacially interesting for 0D 919 !Config simulations. On the globe it does not make too much sense as 920 !Config it imposes the same soil everywhere 921 ! 922 impsoilt = .FALSE. 923 CALL getin_p('IMPOSE_SOILT', impsoilt) 924 IF (impsoilt) THEN 925 !Config Key = SOIL_FRACTIONS 926 !Config Desc = Fraction of the 3 soil types (0-dim mode) 927 !Config Def = 0.28, 0.52, 0.20 928 !Config If = IMPOSE_VEG 929 !Config If = IMPOSE_SOILT 930 !Config Help = Determines the fraction for the 3 soil types 931 !Config in the mesh in the following order : sand loam and clay. 932 ! 933 CALL setvar_p (soiltype, val_exp, 'SOIL_FRACTIONS', soiltype_default) 934 935 !Config Key = CLAY_FRACTION 936 !Config Desc = Fraction of the clay fraction (0-dim mode) 937 !Config Def = 0.2 938 !Config If = IMPOSE_VEG 939 !Config If = IMPOSE_SOILT 940 !Config Help = Determines the fraction of clay in the grid box. 941 ! 942 CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default) 943 ELSE 944 IF ( MINVAL(soiltype) .EQ. MAXVAL(soiltype) .AND. MAXVAL(soiltype) .EQ. val_exp .OR.& 945 & MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp) THEN 946 947 CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soiltype, clayfraction) 948 ENDIF 949 ENDIF 926 950 ! 927 951 !Config Key = SLOWPROC_HEIGHT … … 1005 1029 ! If restart doesn't contain veget, then it is the first computation 1006 1030 CALL slowproc_update(kjpindex, lalo, neighbours, resolution, contfrac, & 1007 & veget_max, frac_nobio, veget_max, frac_nobio, veget_year, init=.TRUE.)1031 & veget_nextyear, frac_nobio_nextyear, veget_max, frac_nobio, veget_year, init=.TRUE.) 1008 1032 ! 1009 1033 IF ( control%ok_dgvm ) THEN … … 1172 1196 ! 1173 1197 CASE('MAXR') 1174 pref_soil_veg(:,1) = pref_soil_veg_sand 1175 pref_soil_veg(:,2) = pref_soil_veg_loan 1176 pref_soil_veg(:,3) = pref_soil_veg_clay 1198 pref_soil_veg(:,1) = pref_soil_veg_sand(:) 1199 pref_soil_veg(:,2) = pref_soil_veg_loan(:) 1200 pref_soil_veg(:,3) = pref_soil_veg_clay(:) 1177 1201 ! 1178 1202 ! Current default : equidistribution. … … 1365 1389 ! 1366 1390 1367 IF ( ( tau .LT. dt ) .OR. ( dt .LE. 0. ) .OR. ( tau .LE. 0.) ) THEN1391 IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN 1368 1392 WRITE(numout,*) 'slowproc_long: Problem with time steps' 1369 1393 WRITE(numout,*) 'dt=',dt … … 1411 1435 ! 1.1 Sum up 1412 1436 ! 1413 fracsum(:) = 0.1437 fracsum(:) = zero 1414 1438 DO jv = 1, nnobio 1415 1439 DO ji = 1, kjpindex … … 1477 1501 ENDDO 1478 1502 ENDDO 1479 1480 1503 ! 1481 1504 ! 3. if lai of a vegetation type (jv > 1) is small, increase soil part … … 1501 1524 ! Ajout Nouveau calcul (stomate-like) 1502 1525 DO ji = 1, kjpindex 1503 SUMveg = 0.01526 SUMveg = zero 1504 1527 veget(ji,1) = veget_max(ji,1) 1505 1528 DO jv = 2, nvm 1506 veget(ji,jv) = veget_max(ji,jv) * ( 1.- exp( - lai(ji,jv) * ext_coeff(jv) ) )1529 veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coeff(jv) ) ) 1507 1530 veget(ji,1) = veget(ji,1) + (veget_max(ji,jv) - veget(ji,jv)) 1508 1531 SUMveg = SUMveg + veget(ji,jv) … … 1515 1538 ENDIF 1516 1539 ENDDO 1517 1518 1540 ! 1519 1541 ! 4. Sum up surface fractions and test if the sum is equal to 1 … … 1523 1545 ! 4.1 Sum up 1524 1546 ! 1525 fracsum(:) = 0.1547 fracsum(:) = zero 1526 1548 DO jv = 1, nnobio 1527 1549 DO ji = 1, kjpindex … … 1599 1621 REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x an y of the grid (m) 1600 1622 1601 REAL(r_std), DIMENSION( kjpindex,nvm,12), INTENT(in):: laimap !! LAI lue1623 REAL(r_std), DIMENSION(:,:,:), INTENT(in) :: laimap !! LAI lue 1602 1624 LOGICAL, INTENT(in) :: read_lai 1603 1625 ! 0.2 Output … … 1610 1632 ! Test Nathalie. On impose LAI PFT 1 a 0 1611 1633 ! On boucle sur 2,nvm au lieu de 1,nvm 1612 lai(: ,1) = 0.01634 lai(: ,1) = zero 1613 1635 DO jv = 2,nvm 1614 1636 !!$ DO jv = 1,nvm … … 1771 1793 ! 1772 1794 WHERE ( laimaporig(:,:,:) .LT. 0 ) 1773 laimaporig(:,:,:) = 0.1795 laimaporig(:,:,:) = zero 1774 1796 ENDWHERE 1775 1797 ! … … 1831 1853 ilast = 1 1832 1854 n_origlai(:) = 0 1833 laimap(:,:,:) = 0.1855 laimap(:,:,:) = zero 1834 1856 ! 1835 1857 DO ip=1,ijml … … 1943 1965 ! Antartica 1944 1966 DO jv =1,nvm 1945 laimap(ip,jv,:) = 0.1967 laimap(ip,jv,:) = zero 1946 1968 ENDDO 1947 1969 ! … … 1949 1971 ! Artica 1950 1972 DO jv =1,nvm 1951 laimap(ip,jv,:) = 0.1973 laimap(ip,jv,:) = zero 1952 1974 ENDDO 1953 1975 ! … … 1955 1977 ! Greenland 1956 1978 DO jv =1,nvm 1957 laimap(ip,jv,:) = 0.1979 laimap(ip,jv,:) = zero 1958 1980 ENDDO 1959 1981 ! … … 2590 2612 DO ib = 1, nbpt 2591 2613 idi=1 2592 sumf= 0.2614 sumf=zero 2593 2615 DO WHILE ( sub_area(ib,idi) > zero ) 2594 2616 ip = sub_index(ib,idi,1) … … 2622 2644 IF (PRESENT(init)) THEN 2623 2645 IF (init) THEN 2624 ! veget_next(ib,:) = (/ 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) 2625 veget_next(ib,1) = 1. 2646 veget_next(ib,1) = un 2626 2647 veget_next(ib,2:nvm) = zero 2627 2648 ELSE … … 2658 2679 ! 2659 2680 idi=1 2660 sumf= 0.2681 sumf=zero 2661 2682 DO WHILE ( sub_area(ib,idi) > zero ) 2662 2683 ip = sub_index(ib,idi,1) … … 2763 2784 err=norm-un 2764 2785 IF (debug) & 2765 WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))- 1., sumf",err,sumf2766 IF (abs(err) > -EPSILON( 1._r_std)) THEN2786 WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf 2787 IF (abs(err) > -EPSILON(un)) THEN 2767 2788 !MM 1.9.3 2768 2789 ! IF (abs(err) > 0.) THEN … … 2775 2796 err=norm-un 2776 2797 IF (debug) & 2777 WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))- 1.",err2778 IF (abs(err) > EPSILON( 1._r_std)) THEN2798 WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err 2799 IF (abs(err) > EPSILON(un)) THEN 2779 2800 !MM 1.9.3 2780 2801 ! IF (abs(err) > 0.) THEN … … 2927 2948 ! 2928 2949 ! 2929 veget(ib,:) = 0.02930 frac_nobio (ib,:) = 0.02950 veget(ib,:) = zero 2951 frac_nobio (ib,:) = zero 2931 2952 ! 2932 2953 ENDDO … … 3063 3084 frac_origveg(:,vid) = REAL(n_origveg(:,vid),r_std) / REAL(n_found(:),r_std) 3064 3085 ELSEWHERE 3065 frac_origveg(:,vid) = 0.3086 frac_origveg(:,vid) = zero 3066 3087 ENDWHERE 3067 3088 ENDDO … … 3099 3120 IF ( lalo(ib,1) .LT. -56.0) THEN 3100 3121 ! Antartica 3101 frac_nobio(ib,:) = 0.03102 frac_nobio(ib,iice) = 1.03103 veget(ib,:) = 0.03122 frac_nobio(ib,:) = zero 3123 frac_nobio(ib,iice) = un 3124 veget(ib,:) = zero 3104 3125 ! 3105 3126 ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 3106 3127 ! Artica 3107 frac_nobio(ib,:) = 0.03108 frac_nobio(ib,iice) = 1.03109 veget(ib,:) = 0.03128 frac_nobio(ib,:) = zero 3129 frac_nobio(ib,iice) = un 3130 veget(ib,:) = zero 3110 3131 ! 3111 3132 ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 3112 3133 ! Greenland 3113 frac_nobio(ib,:) = 0.03114 frac_nobio(ib,iice) = 1.03115 veget(ib,:) = 0.03134 frac_nobio(ib,:) = zero 3135 frac_nobio(ib,iice) = un 3136 veget(ib,:) = zero 3116 3137 ! 3117 3138 ELSE … … 3144 3165 DO vid = 1, nvm 3145 3166 IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 3146 veget(ib,vid) = 0.03167 veget(ib,vid) = zero 3147 3168 ENDIF 3148 3169 ENDDO … … 3346 3367 frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:) 3347 3368 ELSEWHERE 3348 frac_origveg(:,vid) = 0.3369 frac_origveg(:,vid) = zero 3349 3370 ENDWHERE 3350 3371 ENDDO … … 3382 3403 IF ( lalo(ib,1) .LT. -56.0) THEN 3383 3404 ! Antartica 3384 frac_nobio(ib,:) = 0.03385 frac_nobio(ib,iice) = 1.03386 veget(ib,:) = 0.03405 frac_nobio(ib,:) = zero 3406 frac_nobio(ib,iice) = un 3407 veget(ib,:) = zero 3387 3408 ! 3388 3409 ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 3389 3410 ! Artica 3390 frac_nobio(ib,:) = 0.03391 frac_nobio(ib,iice) = 1.03392 veget(ib,:) = 0.03411 frac_nobio(ib,:) = zero 3412 frac_nobio(ib,iice) = un 3413 veget(ib,:) = zero 3393 3414 ! 3394 3415 ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 3395 3416 ! Greenland 3396 frac_nobio(ib,:) = 0.03397 frac_nobio(ib,iice) = 1.03398 veget(ib,:) = 0.03417 frac_nobio(ib,:) = zero 3418 frac_nobio(ib,iice) = un 3419 veget(ib,:) = zero 3399 3420 ! 3400 3421 ELSE … … 3427 3448 DO vid = 1, nvm 3428 3449 IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 3429 veget(ib,vid) = 0.03450 veget(ib,vid) = zero 3430 3451 ENDIF 3431 3452 ENDDO … … 3554 3575 ! 3555 3576 ! 3556 veget(ib,:) = 0.03557 frac_nobio (ib,:) = 0.03577 veget(ib,:) = zero 3578 frac_nobio (ib,:) = zero 3558 3579 ! 3559 3580 ENDDO … … 3690 3711 frac_origveg(:,vid) = REAL(n_origveg(:,vid),r_std) / REAL(n_found(:),r_std) 3691 3712 ELSEWHERE 3692 frac_origveg(:,vid) = 0.3713 frac_origveg(:,vid) = zero 3693 3714 ENDWHERE 3694 3715 ENDDO … … 3726 3747 IF ( lalo(ib,1) .LT. -56.0) THEN 3727 3748 ! Antartica 3728 frac_nobio(ib,:) = 0.03729 frac_nobio(ib,iice) = 1.03730 veget(ib,:) = 0.03749 frac_nobio(ib,:) = zero 3750 frac_nobio(ib,iice) = un 3751 veget(ib,:) = zero 3731 3752 ! 3732 3753 ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 3733 3754 ! Artica 3734 frac_nobio(ib,:) = 0.03735 frac_nobio(ib,iice) = 1.03736 veget(ib,:) = 0.03755 frac_nobio(ib,:) = zero 3756 frac_nobio(ib,iice) = un 3757 veget(ib,:) = zero 3737 3758 ! 3738 3759 ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 3739 3760 ! Greenland 3740 frac_nobio(ib,:) = 0.03741 frac_nobio(ib,iice) = 1.03742 veget(ib,:) = 0.03761 frac_nobio(ib,:) = zero 3762 frac_nobio(ib,iice) = un 3763 veget(ib,:) = zero 3743 3764 ! 3744 3765 ELSE … … 3771 3792 DO vid = 1, nvm 3772 3793 IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 3773 veget(ib,vid) = 0.03794 veget(ib,vid) = zero 3774 3795 ENDIF 3775 3796 ENDDO … … 3962 3983 frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:) 3963 3984 ELSEWHERE 3964 frac_origveg(:,vid) = 0.3985 frac_origveg(:,vid) = zero 3965 3986 ENDWHERE 3966 3987 ENDDO … … 3998 4019 IF ( lalo(ib,1) .LT. -56.0) THEN 3999 4020 ! Antartica 4000 frac_nobio(ib,:) = 0.04001 frac_nobio(ib,iice) = 1.04002 veget(ib,:) = 0.04021 frac_nobio(ib,:) = zero 4022 frac_nobio(ib,iice) = un 4023 veget(ib,:) = zero 4003 4024 ! 4004 4025 ELSE IF ( lalo(ib,1) .GT. 70.0) THEN 4005 4026 ! Artica 4006 frac_nobio(ib,:) = 0.04007 frac_nobio(ib,iice) = 1.04008 veget(ib,:) = 0.04027 frac_nobio(ib,:) = zero 4028 frac_nobio(ib,iice) = un 4029 veget(ib,:) = zero 4009 4030 ! 4010 4031 ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN 4011 4032 ! Greenland 4012 frac_nobio(ib,:) = 0.04013 frac_nobio(ib,iice) = 1.04014 veget(ib,:) = 0.04033 frac_nobio(ib,:) = zero 4034 frac_nobio(ib,iice) = un 4035 veget(ib,:) = zero 4015 4036 ! 4016 4037 ELSE … … 4043 4064 DO vid = 1, nvm 4044 4065 IF ( veget(ib,vid) .LT. min_vegfrac ) THEN 4045 veget(ib,vid) = 0.04066 veget(ib,vid) = zero 4046 4067 ENDIF 4047 4068 ENDDO -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/thermosoil.f90
r64 r257 3 3 !! 4 4 !! @author Marie-Alice Foujols and Jan Polcher 5 !! @Version : $Revision: 1.15 $, $Date: 2009/01/07 13:39:45$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/thermosoil.f90,v 1.15 2009/01/07 13:39:45 ssipsl Exp $ 7 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/thermosoil.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 … … 98 101 REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol_new !! New soil temperature 99 102 REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow quantity 103 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: shumdiag !! Diagnostic of relative humidity 100 104 ! output fields 101 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: soilcap !! Soil capacity 102 REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: soilflx 103 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: shumdiag !! Diagnostic of relative humidity 104 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: stempdiag !! diagnostic temp profile 105 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: soilcap !! Soil capacity 106 REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: soilflx 107 REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout):: stempdiag !! diagnostic temp profile 105 108 106 109 REAL(r_std),DIMENSION (kjpindex,ngrnd) :: temp … … 645 648 REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: soilflx !! 646 649 REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: z1 !! 647 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT( out) :: pcapa !!648 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT( out) :: pcapa_en !!649 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT( out) :: pkappa !!650 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pcapa !! 651 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pcapa_en !! 652 REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pkappa !! 650 653 REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: cgrnd !! 651 654 REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: dgrnd !! … … 837 840 lev_prog = prev_prog + dz2(jg) 838 841 ENDIF 839 intfact(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), 0.0)/(lev_diag-prev_diag)842 intfact(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag) 840 843 prev_prog = lev_prog 841 844 ENDDO … … 857 860 ENDIF 858 861 859 stempdiag(:,:) = 0.862 stempdiag(:,:) = zero 860 863 DO jg = 1, ngrnd 861 864 DO jd = 1, nbdl … … 907 910 lev_prog = diaglev(jg) 908 911 ENDIF 909 intfactw(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), 0.0)/(lev_diag-prev_diag)912 intfactw(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag) 910 913 prev_prog = lev_prog 911 914 ENDDO … … 927 930 ENDIF 928 931 929 wetdiag(:,:) = 0.932 wetdiag(:,:) = zero 930 933 DO jg = 1, nbdl 931 934 DO jd = 1, ngrnd -
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/watchout.f90
r64 r257 3 3 USE defprec 4 4 USE parallel 5 USE constantes 5 6 USE netcdf 6 7 … … 10 11 11 12 LOGICAL,SAVE,PUBLIC :: ok_watchout = .FALSE. 12 REAL, SAVE,PUBLIC :: dt_watch = 0.13 REAL, SAVE,PUBLIC :: dt_watch = zero 13 14 INTEGER, SAVE,PUBLIC :: last_action_watch = 0, & 14 15 & last_check_watch = 0
Note: See TracChangeset
for help on using the changeset viewer.
