Changeset 277


Ignore:
Timestamp:
2011-06-23T11:25:25+02:00 (11 years ago)
Author:
didier.solyga
Message:

Update the externalized version with the last commit of the trunk (revision 275)

Location:
branches/ORCHIDEE_EXT/ORCHIDEE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90

    r257 r277  
    77!! 
    88!! @call sechiba_main 
    9 !! @Version : $Revision: 221 $, $Date: 2011-05-16 17:26:17 +0200 (Mon, 16 May 2011) $ 
     9!! @Version : $Revision: 275 $, $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 
    1010!! 
    1111!! @author Marie-Alice Foujols and Jan Polcher 
    1212!!  
    1313!< $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) $ 
     14!< $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 
    1515!< $Author: martial.mancip $ 
    16 !< $Revision: 221 $ 
     16!< $Revision: 275 $ 
    1717!! IPSL (2006) 
    1818!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC 
     
    162162    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastalflow 
    163163    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep riverflow 
     164    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     165    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    164166    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    165167    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
     
    357359       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zpb, & 
    358360! Output : Fluxes 
    359        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     361       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    360362! Surface temperatures and surface properties 
    361363       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
     
    701703    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    702704    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     705    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     706    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    703707    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    704708    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
     
    874878       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zpb, & 
    875879! Output : Fluxes 
    876        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     880       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    877881! Surface temperatures and surface properties 
    878882       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
     
    12111215    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    12121216    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     1217    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     1218    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    12131219    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    12141220    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
     
    15711577       & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, pb, & 
    15721578! Output : Fluxes 
    1573        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     1579       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    15741580! Surface temperatures and surface properties 
    15751581       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
     
    18501856     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 
    18511857! Ajout Nathalie - passage q2m/t2m pour calcul Rveget 
    1852      & q2m, t2m)   
     1858     & q2m, t2m, & 
     1859! Add emission/deposit fields 
     1860     & field_out_names, fields_out, field_in_names, fields_in)   
    18531861#else 
    18541862  SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, & 
     
    18661874     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 
    18671875! Ajout Nathalie - passage q2m/t2m pour calcul Rveget 
    1868      & q2m, t2m)   
     1876     & q2m, t2m, & 
     1877! Add emission/deposit fields 
     1878     & field_out_names, fields_out, field_in_names, fields_in) 
    18691879#endif 
    18701880    ! routines called : sechiba_main 
     
    19251935    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxlat       !! Latent chaleur flux 
    19261936    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: emis          !! Emissivity 
     1937    ! 
     1938    ! Optional arguments 
     1939    ! 
     1940    ! Names and fields for emission variables : to be transport by GCM to chemistry model. 
     1941    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names 
     1942    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out 
     1943    ! 
     1944    ! Names and fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE. 
     1945    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names 
     1946    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in 
     1947    ! 
    19271948    ! LOCAL declaration 
    19281949    ! work arrays to scatter and/or gather information just before/after sechiba_main call's 
     
    19371958    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow 
    19381959    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow 
     1960    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux 
     1961    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use 
    19391962    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad 
    19401963    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp 
     
    19481971    ! Optional arguments 
    19491972    ! 
    1950     REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN), OPTIONAL :: lon_scat_g, lat_scat_g !! The scattered values for longitude  
     1973    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g, lat_scat_g !! The scattered values for longitude  
    19511974    ! 
    19521975    INTEGER(i_std)                          :: iim,jjm                                  !! local sizes 
     
    19802003    LOGICAL, SAVE                                         :: fatmco2       !! Flag to force the value of atmospheric CO2 for vegetation. 
    19812004    REAL(r_std), SAVE                                     :: atmco2        !! atmospheric CO2  
     2005    ! 
     2006    ! Number of fields to give (nb_fields_out) or get from (nb_fields_in) GCM : 
     2007    INTEGER(i_std), SAVE                                  :: nb_fields_out, nb_fields_in 
     2008    ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) GCM : 
     2009    INTEGER(i_std)                                        :: i_fields_out, i_fields_in 
    19822010    ! 
    19832011    CALL ipslnlf(old_number=old_fileout) 
     
    20632091       !  we have to do the work here. 
    20642092       ! 
    2065        IF ( PRESENT(lon_scat_g) .AND. PRESENT(lat_scat_g)) THEN 
     2093       IF ( .TRUE. ) THEN 
    20662094           
    20672095          lon_scat(:,:)=zero 
     
    20812109             lat_g(:,:) = lat_scat_g(:,:) 
    20822110          ENDIF 
    2083  
    2084        ELSE IF ( PRESENT(lon_scat_g) .OR. PRESENT(lat_scat_g)) THEN 
    2085  
    2086           WRITE(numout,*) 'You need to provide the longitude AND latitude on the' 
    2087           WRITE(numout,*) 'gathered grid in order to start ORCHIDEE.' 
    2088           STOP 'intersurf_gathered' 
    20892111 
    20902112       ELSE 
     
    21982220       ENDIF 
    21992221       ! 
     2222 
     2223       ! Prepare fieds out/in for interface with GCM. 
     2224       IF (PRESENT(field_out_names)) THEN 
     2225          nb_fields_out=SIZE(field_out_names) 
     2226       ELSE 
     2227          nb_fields_out=0 
     2228       ENDIF 
     2229       IF (PRESENT(field_in_names)) THEN 
     2230          nb_fields_in=SIZE(field_in_names) 
     2231       ELSE 
     2232          nb_fields_in=0 
     2233       ENDIF 
     2234 
    22002235       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf' 
    22012236       ! 
     
    22512286       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac 
    22522287    ENDIF 
     2288 
     2289 
     2290    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE. 
     2291    WRITE(numout,*) "Get fields from atmosphere." 
     2292 
     2293    DO i_fields_in=1,nb_fields_in 
     2294       WRITE(numout,*) i_fields_in," Champ = ",TRIM(field_in_names(i_fields_in))  
     2295       SELECT CASE(TRIM(field_in_names(i_fields_in))) 
     2296       CASE DEFAULT  
     2297          CALL ipslerr (3,'intsurf_gathered_2m', & 
     2298            &          'You ask in GCM an unknown field '//TRIM(field_in_names(i_fields_in))//& 
     2299            &          ' to give to ORCHIDEE for this specific version.',& 
     2300            &          'This model won''t be able to continue.', & 
     2301            &          '(check your tracer parameters in GCM)') 
     2302       END SELECT 
     2303    ENDDO 
     2304 
    22532305    ! 
    22542306    ! 2. modification of co2 
     
    23012353       & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, pb, & 
    23022354! Output : Fluxes 
    2303        & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, & 
     2355       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 
    23042356! Surface temperatures and surface properties 
    23052357       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & 
     
    25532605       riverflow(ik) = riverflow(ik)/xrdt 
    25542606 
     2607    ENDDO 
     2608    ! 
     2609    WRITE(numout,*) "Give fields to atmosphere." 
     2610     
     2611    ! Fields for emission variables : to be transport by GCM to chemistry model. 
     2612    DO i_fields_out=1,nb_fields_out 
     2613       SELECT CASE(TRIM(field_out_names(i_fields_out))) 
     2614       CASE("fCO2_land")  
     2615          fields_out(:,i_fields_out)=znetco2(:) 
     2616       CASE("fCO2_land_use") 
     2617          fields_out(:,i_fields_out)=zcarblu(:) 
     2618       CASE DEFAULT  
     2619          CALL ipslerr (3,'intsurf_gathered_2m', & 
     2620            &          'You ask from GCM an unknown field '//TRIM(field_out_names(i_fields_out))//& 
     2621            &          ' to ORCHIDEE for this specific version.',& 
     2622            &          'This model won''t be able to continue.', & 
     2623            &          '(check your tracer parameters in GCM)') 
     2624       END SELECT 
    25552625    ENDDO 
    25562626    ! 
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/routing.f90

    r64 r277  
    1919!! 
    2020!! @author Jan Polcher 
    21 !! @Version : $Revision: 1.41 $, $Date: 2009/01/07 13:39:45 $ 
     21!! @Version : $Revision: 274 $, $Date: 2011-06-21 15:18:18 +0200 (Tue, 21 Jun 2011) $ 
    2222!! 
    23 !! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/routing.f90,v 1.41 2009/01/07 13:39:45 ssipsl Exp $ 
     23!< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/routing.f90 $ 
     24!< $Date: 2011-06-21 15:18:18 +0200 (Tue, 21 Jun 2011) $ 
     25!< $Author: martial.mancip $ 
     26!< $Revision: 274 $ 
    2427!! IPSL (2006) 
    2528!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC 
     
    285288       DO ig=1,nbpt 
    286289          IF ( lalo(ig,1) > 49.0 ) THEN 
    287              floodtemp(ig) = tp_00 -1. 
     290             floodtemp(ig) = tp_00 - un 
    288291          ENDIF 
    289292       ENDDO 
     
    499502    !Config If   = RIVER_ROUTING 
    500503    !Config Desc = Time step of th routing scheme 
    501     !Config Def  = 86400 
     504    !Config Def  = one_day 
    502505    !Config Help = This values gives the time step in seconds of the routing scheme.  
    503506    !Config        It should be multiple of the main time step of ORCHIDEE. One day 
     
    569572       CALL restget (rest_id, var_name, 1, 1, 1, kjit, .TRUE., tmp_day) 
    570573       time_counter = tmp_day(1)  
    571        CALL setvar (time_counter, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     574       CALL setvar (time_counter, val_exp, 'NO_KEYWORD', zero) 
    572575    ENDIF 
    573576    CALL bcast(time_counter) 
    574 !!$    CALL setvar_p (time_counter, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     577!!$    CALL setvar_p (time_counter, val_exp, 'NO_KEYWORD', zero) 
    575578 
    576579    ! 
     
    650653    CALL ioconf_setatt('LONG_NAME','Water in the fast reservoir') 
    651654    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., fast_reservoir, "gather", nbp_glo, index_g) 
    652     CALL setvar_p (fast_reservoir, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     655    CALL setvar_p (fast_reservoir, val_exp, 'NO_KEYWORD', zero) 
    653656    ! 
    654657    ALLOCATE (slow_reservoir(nbpt,nbasmax)) 
     
    657660    CALL ioconf_setatt('LONG_NAME','Water in the slow reservoir') 
    658661    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., slow_reservoir, "gather", nbp_glo, index_g) 
    659     CALL setvar_p (slow_reservoir, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     662    CALL setvar_p (slow_reservoir, val_exp, 'NO_KEYWORD', zero) 
    660663    ! 
    661664    ALLOCATE (stream_reservoir(nbpt,nbasmax)) 
     
    664667    CALL ioconf_setatt('LONG_NAME','Water in the stream reservoir') 
    665668    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., stream_reservoir, "gather", nbp_glo, index_g) 
    666     CALL setvar_p (stream_reservoir, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     669    CALL setvar_p (stream_reservoir, val_exp, 'NO_KEYWORD', zero) 
    667670    ! 
    668671    ALLOCATE (lake_reservoir(nbpt)) 
     
    671674    CALL ioconf_setatt('LONG_NAME','Water in the lake reservoir') 
    672675    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., lake_reservoir, "gather", nbp_glo, index_g) 
    673     CALL setvar (lake_reservoir, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     676    CALL setvar_p (lake_reservoir, val_exp, 'NO_KEYWORD', zero) 
    674677    ! 
    675678    ! Map of irrigated areas 
     
    689692    CALL ioconf_setatt('LONG_NAME','Previous outflow from this basin') 
    690693    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax+3, 1, kjit, .TRUE., previous_outflow, "gather", nbp_glo, index_g) 
    691     CALL setvar_p (previous_outflow, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     694    CALL setvar_p (previous_outflow, val_exp, 'NO_KEYWORD', zero) 
    692695    ! 
    693696    IF ( dofloodplains ) THEN 
     
    707710    CALL ioconf_setatt('LONG_NAME','Lake inflow') 
    708711    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., lakeinflow_mean, "gather", nbp_glo, index_g) 
    709     CALL setvar_p (lakeinflow_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     712    CALL setvar_p (lakeinflow_mean, val_exp, 'NO_KEYWORD', zero) 
    710713    ! 
    711714    ALLOCATE (returnflow_mean(nbpt)) 
     
    714717    CALL ioconf_setatt('LONG_NAME','Deep return flux') 
    715718    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., returnflow_mean, "gather", nbp_glo, index_g) 
    716     CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     719    CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', zero) 
    717720    returnflow(:) = returnflow_mean(:) 
    718721    ! 
     
    726729       CALL ioconf_setatt('LONG_NAME','Artificial irrigation flux') 
    727730       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., irrigation_mean, "gather", nbp_glo, index_g) 
    728        CALL setvar_p (irrigation_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
    729        irrigation(:) = irrigation_mean(:)  
    730    ELSE 
     731       CALL setvar_p (irrigation_mean, val_exp, 'NO_KEYWORD', zero) 
     732    ELSE 
    731733       irrigation_mean(:) = zero 
    732734    ENDIF 
     735    irrigation(:) = irrigation_mean(:)  
    733736    ! 
    734737    ALLOCATE (riverflow_mean(nbpt)) 
     
    737740    CALL ioconf_setatt('LONG_NAME','River flux into the sea') 
    738741    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., riverflow_mean, "gather", nbp_glo, index_g) 
    739     CALL setvar_p (riverflow_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     742    CALL setvar_p (riverflow_mean, val_exp, 'NO_KEYWORD', zero) 
    740743    riverflow(:) = riverflow_mean(:) 
    741744    ! 
     
    745748    CALL ioconf_setatt('LONG_NAME','Diffuse flux into the sea') 
    746749    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., coastalflow_mean, "gather", nbp_glo, index_g) 
    747     CALL setvar_p (coastalflow_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     750    CALL setvar_p (coastalflow_mean, val_exp, 'NO_KEYWORD', zero) 
    748751    coastalflow(:) = coastalflow_mean(:) 
    749752    ! 
     
    759762    CALL ioconf_setatt('LONG_NAME','Hydrograph at outlow of grid') 
    760763    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., hydrographs, "gather", nbp_glo, index_g) 
    761     CALL setvar_p (hydrographs, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     764    CALL setvar_p (hydrographs, val_exp, 'NO_KEYWORD', zero) 
    762765    ! 
    763766    ! The diagnostic variables, they are initialized from the above restart variables. 
     
    799802    CALL ioconf_setatt('LONG_NAME','Accumulated runoff for routing') 
    800803    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff_mean, "gather", nbp_glo, index_g) 
    801     CALL setvar_p (runoff_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     804    CALL setvar_p (runoff_mean, val_exp, 'NO_KEYWORD', zero) 
    802805    ! 
    803806    ALLOCATE(drainage_mean(nbpt)) 
     
    806809    CALL ioconf_setatt('LONG_NAME','Accumulated drainage for routing') 
    807810    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage_mean, "gather", nbp_glo, index_g) 
    808     CALL setvar_p (drainage_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     811    CALL setvar_p (drainage_mean, val_exp, 'NO_KEYWORD', zero) 
    809812    ! 
    810813    ALLOCATE(evapot_mean(nbpt)) 
     
    813816    CALL ioconf_setatt('LONG_NAME','Accumulated potential evaporation for routing') 
    814817    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot_mean, "gather", nbp_glo, index_g) 
    815     CALL setvar_p (evapot_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     818    CALL setvar_p (evapot_mean, val_exp, 'NO_KEYWORD', zero) 
    816819    ! 
    817820    ALLOCATE(precip_mean(nbpt)) 
     
    820823    CALL ioconf_setatt('LONG_NAME','Accumulated rain precipitation for irrigation') 
    821824    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., precip_mean, "gather", nbp_glo, index_g) 
    822     CALL setvar_p (precip_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     825    CALL setvar_p (precip_mean, val_exp, 'NO_KEYWORD', zero) 
    823826    ! 
    824827    ALLOCATE(humrel_mean(nbpt)) 
     
    827830    CALL ioconf_setatt('LONG_NAME','Mean humrel for irrigation') 
    828831    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., humrel_mean, "gather", nbp_glo, index_g) 
    829     CALL setvar_p (humrel_mean, val_exp, 'NO_KEYWORD', 1.0_r_std) 
     832    CALL setvar_p (humrel_mean, val_exp, 'NO_KEYWORD', un) 
    830833    ! 
    831834    ALLOCATE(totnobio_mean(nbpt)) 
     
    834837    CALL ioconf_setatt('LONG_NAME','Last Total fraction of no bio for irrigation') 
    835838    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., totnobio_mean, "gather", nbp_glo, index_g) 
    836     CALL setvar_p (totnobio_mean, val_exp, 'NO_KEYWORD', 0.0_r_std) 
     839    CALL setvar_p (totnobio_mean, val_exp, 'NO_KEYWORD', zero) 
    837840    ! 
    838841    ALLOCATE(vegtot_mean(nbpt)) 
     
    841844    CALL ioconf_setatt('LONG_NAME','Last Total fraction of vegetation') 
    842845    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_mean, "gather", nbp_glo, index_g) 
    843     CALL setvar_p (vegtot_mean, val_exp, 'NO_KEYWORD', 1.0_r_std) 
     846    CALL setvar_p (vegtot_mean, val_exp, 'NO_KEYWORD', un) 
    844847    ! 
    845848    ! 
     
    978981             ! 
    979982          ELSE 
    980              fast_flow(ig,ib) = 0.0 
    981              slow_flow(ig,ib) = 0.0 
    982              stream_flow(ig,ib) = 0.0 
     983             fast_flow(ig,ib) = zero 
     984             slow_flow(ig,ib) = zero 
     985             stream_flow(ig,ib) = zero 
    983986          ENDIF 
    984987          inflow(ig,ib) = fast_flow(ig,ib) + slow_flow(ig,ib) + stream_flow(ig,ib) 
     
    994997             potflood(ig,ib) = inflow(ig,ib) - previous_outflow(ig,ib) 
    995998             ! 
    996              IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib) > 0. .AND. floodtemp(ig) > tp_00 ) THEN 
     999             IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib) > zero .AND. floodtemp(ig) > tp_00 ) THEN 
    9971000                ! 
    9981001                IF (routing_area(ig,ib) > tobeflooded(ig)) THEN 
    9991002                   floodindex = tobeflooded(ig) / routing_area(ig,ib) 
    10001003                   ELSE 
    1001                       floodindex = 1.0 
     1004                      floodindex = un 
    10021005                ENDIF 
    10031006                ! 
     
    10331036!ym mais n'est pas la plus efficace 
    10341037 
    1035     IF (is_root_prc) & 
    1036          ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), & 
    1037           stream_flow_g(nbp_glo, nbasmax), floods_g(nbp_glo, nbasmax), wdelay_g(nbp_glo, nbasmax) ) 
     1038    IF (is_root_prc)  THEN 
     1039       ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), & 
     1040            stream_flow_g(nbp_glo, nbasmax), floods_g(nbp_glo, nbasmax),  & 
     1041            wdelay_g(nbp_glo, nbasmax) ) 
     1042    ELSE 
     1043       ALLOCATE( fast_flow_g(1,1), slow_flow_g(1,1), & 
     1044            stream_flow_g(1, 1), floods_g(1,1),  & 
     1045            wdelay_g(1,1) ) 
     1046    ENDIF 
    10381047     
    10391048        
     
    10571066    ENDIF 
    10581067 
    1059     IF (is_root_prc) & 
    1060          DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g, floods_g, wdelay_g ) 
    1061     
     1068    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g, floods_g, wdelay_g ) 
     1069       
    10621070    CALL scatter(transport_glo,transport) 
    10631071 
     
    11151123       DO ig=1,nbpt 
    11161124           
    1117           IF ((vegtot(ig) .GT. 0.0) .AND. (humrel(ig) .LT. 0.99)) THEN 
    1118              irrig_netereq(ig) = (irrigated(ig) / totarea(ig) ) * MAX(0.0, & 
     1125          IF ((vegtot(ig) .GT. zero) .AND. (humrel(ig) .LT. 0.99)) THEN 
     1126             irrig_netereq(ig) = (irrigated(ig) / totarea(ig) ) * MAX(zero, & 
    11191127                  & crop_coef * evapot(ig) - & 
    11201128                  & MAX(precip(ig)+returnflow(ig)-runoff(ig)-drainage(ig), zero) ) 
    11211129             irrig_netereq(ig) = 1 * irrig_netereq(ig) 
    11221130              
    1123              IF(irrig_netereq(ig).LT.0.0) THEN 
     1131             IF(irrig_netereq(ig).LT.zero) THEN 
    11241132                WRITE(numout,*) 'there is a probleme for irrig_netereq',ig,irrig_netereq(ig) 
    11251133             ENDIF 
     
    11331141                     &   stream_reservoir(ig,ib) + fast_reservoir(ig,ib) + slow_reservoir(ig,ib) ) 
    11341142                 
    1135                 slow_reservoir(ig,ib) = MAX(0.0, slow_reservoir(ig,ib) + & 
    1136                      & MIN(0.0, fast_reservoir(ig,ib) + MIN(0.0, stream_reservoir(ig,ib)-baseirrig(ig,ib)))) 
     1143                slow_reservoir(ig,ib) = MAX(zero, slow_reservoir(ig,ib) + & 
     1144                     & MIN(zero, fast_reservoir(ig,ib) + MIN(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib)))) 
    11371145 
    1138                 fast_reservoir(ig,ib) = MAX( 0.0, & 
    1139                      &  fast_reservoir(ig,ib) + MIN(0.0, stream_reservoir(ig,ib)-baseirrig(ig,ib))) 
    1140                 stream_reservoir(ig,ib) = MAX(0.0, stream_reservoir(ig,ib)-baseirrig(ig,ib) ) 
     1146                fast_reservoir(ig,ib) = MAX( zero, & 
     1147                     &  fast_reservoir(ig,ib) + MIN(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib))) 
     1148                stream_reservoir(ig,ib) = MAX(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib) ) 
    11411149 
    1142                 IF(baseirrig(ig,ib) .LT. 0.0 .OR. slow_reservoir(ig,ib) .LT. 0.0 .OR. & 
    1143                      & fast_reservoir(ig,ib) .LT. 0.0 .OR. stream_reservoir(ig,ib) .LT. 0.0) THEN 
     1150                IF(baseirrig(ig,ib) .LT. zero .OR. slow_reservoir(ig,ib) .LT. zero .OR. & 
     1151                     & fast_reservoir(ig,ib) .LT. zero .OR. stream_reservoir(ig,ib) .LT. zero) THEN 
    11441152                   WRITE(numout,*) 'There is negative values related to irrigation', ig,ib,baseirrig(ig,ib), & 
    11451153                        & slow_reservoir(ig,ib),fast_reservoir(ig,ib),stream_reservoir(ig,ib) 
     
    13781386    ! 
    13791387    nb_pts(:) = 0 
    1380     totarea(:) = 0.0 
     1388    totarea(:) = zero 
    13811389    hydrodiag(:,:) = 0 
    13821390    DO ig=1,nbpt 
     
    14271435    ! 
    14281436    ! 
    1429     basinmap(:) = 0.0 
     1437    basinmap(:) = zero 
    14301438    DO icc = 1, num_largest 
    14311439       ff = MAXLOC(totarea)    
     
    14451453               & topids(ff(1)), name_str(1:15), totarea(ff(1))/1.e6,  nb_pts(ff(1)) 
    14461454       ENDIF 
    1447        totarea(ff(1)) = 0.0 
     1455       totarea(ff(1)) = zero 
    14481456    ENDDO 
    14491457    ! 
     
    14711479    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid) 
    14721480    ic = COUNT(topo_resid .GT. 0.) 
    1473     WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. 0.)/ic 
    1474     WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. 0.) 
     1481    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. zero)/ic 
     1482    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. zero) 
    14751483    ! 
    14761484    DEALLOCATE(pts) 
     
    15611569    !  0.3 LOCAL 
    15621570    ! 
    1563     ! 
    15641571    CHARACTER(LEN=80) :: filename 
    15651572    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, fopt, lastjp, nbexp 
     
    16741681    nbexp = 0 
    16751682    ! 
    1676     min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-1.) 
     1683    min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-un) 
    16771684    ! 
    16781685    DO ip=1,iml 
     
    18901897       ! 
    18911898       ! 
    1892        ! Set everything to undef to locate easily empty points 
    1893        ! 
    1894        trip_bx(:,:) = undef_int 
    1895        basin_bx(:,:) = undef_int 
    1896        topoind_bx(:,:) = undef_sechiba 
    1897        area_bx(:,:) = undef_sechiba 
    1898        hierarchy_bx(:,:) = undef_sechiba 
    1899        ! 
    19001899       !  extract the information for this grid box 
    19011900       ! 
     
    20742073    INTEGER(i_std) :: ip, jp, ll(1), iloc, jloc 
    20752074    REAL(r_std)    :: lonstr(nbvmax*nbvmax), latstr(nbvmax*nbvmax) 
     2075    ! 
     2076    ! 
     2077    ! Set everything to undef to locate easily empty points 
     2078    ! 
     2079    trip_bx(:,:) = undef_int 
     2080    basin_bx(:,:) = undef_int 
     2081    topoind_bx(:,:) = undef_sechiba 
     2082    area_bx(:,:) = undef_sechiba 
     2083    hierarchy_bx(:,:) = undef_sechiba 
    20762084    ! 
    20772085    IF ( sub_pts(ib) > 0 ) THEN 
     
    31773185       ! Compute the area of the basin 
    31783186       ! 
    3179        basin_area(ib,ij) = 0.0 
    3180        basin_hierarchy(ib,ij) = 0.0 
     3187       basin_area(ib,ij) = zero 
     3188       basin_hierarchy(ib,ij) = zero 
    31813189       ! 
    31823190       SELECT CASE (hierar_method) 
     
    31863194          ! 
    31873195       END SELECT 
    3188        basin_topoind(ib,ij) = 0.0 
     3196       basin_topoind(ib,ij) = zero 
    31893197       ! 
    31903198       DO iz=1,basin_sz(ij) 
     
    32993307    INTEGER(i_std) :: ff(1) 
    33003308    ! 
     3309    ! WARNING 
     3310    LOGICAL, PARAMETER :: check = .FALSE. 
     3311    ! ERRORS  
     3312    LOGICAL :: error1, error2, error3, error4, error5 
     3313     
     3314    error1=.FALSE. 
     3315    error2=.FALSE. 
     3316    error3=.FALSE. 
     3317    error4=.FALSE. 
     3318    error5=.FALSE. 
     3319 
    33013320    outflow_basin(:,:) = undef_int 
    33023321    inflow_number(:,:) = 0 
     
    33733392                      inflow_basin(inp, bop, inflow_number(inp,bop)) = sb 
    33743393                   ELSE 
    3375                       WRITE(numout,*) 'Increase nbvmax' 
    3376                       STOP 'routing_linkup' 
     3394                      error1=.TRUE. 
     3395                      EXIT 
    33773396                   ENDIF 
    33783397                ENDIF 
     
    35283547                                  dop = sp 
    35293548                                  bop = sbl 
    3530                                   IF (basin_hierarchy(sp,sb) .LT. basin_hierarchy(sp,sbl)) THEN 
    3531                                      WRITE(numout,*) '>>>>>>> POINT CORRECTED against hierarchy :',& 
    3532                                           & sp, sb, 'into', sbl 
     3549                                  IF (check) THEN 
     3550                                     IF (basin_hierarchy(sp,sb) .LT. basin_hierarchy(sp,sbl)) THEN 
     3551                                        WRITE(numout,*) '>>>>>>> POINT CORRECTED against hierarchy :',& 
     3552                                             & sp, sb, 'into', sbl 
     3553                                     ENDIF 
    35333554                                  ENDIF 
    35343555                               ENDIF 
     
    35423563                ! 
    35433564                IF ( dop .EQ. undef_int .AND. bop .EQ. undef_int ) THEN 
    3544                    WRITE(numout,*) 'Why are we here with point ', sp, sb 
    3545                    WRITE(numout,*) 'Coodinates : (lon,lat) = ', lalo(sp,2), lalo(sp,1) 
    3546                    WRITE(numout,*) 'Contfrac : = ', contfrac(sp) 
    3547                    WRITE(numout,*) 'Local Basin ID :', basin_id(sp,1:basin_count(sp)) 
    3548                    WRITE(numout,*) 'Local hierarchies :', basin_hierarchy(sp,1:basin_count(sp)) 
    3549                    WRITE(numout,*) 'Local basin_flowdir :', basin_flowdir(sp,1:basin_count(sp)) 
    3550                    WRITE(numout,*) 'Local outflowgrid :', outflow_grid(sp,1:basin_count(sp)) 
    3551                    WRITE(numout,*) 'outflow_grid :', inp 
    3552                    WRITE(numout,*) 'Coodinates outflow : (lon,lat) = ', lalo(inp,2), lalo(inp,1) 
    3553                    WRITE(numout,*) 'Contfrac : = ', contfrac(inp) 
    3554                    WRITE(numout,*) 'Outflow Basin ID :', basin_id(inp,1:basin_count(inp)) 
    3555                    WRITE(numout,*) 'Outflow hierarchies :', basin_hierarchy(inp,1:basin_count(inp)) 
    3556                    WRITE(numout,*) 'Outflow basin_flowdir :', basin_flowdir(inp,1:basin_count(inp)) 
    3557                    WRITE(numout,*) 'Explored options +1 :', dp1, bp1, outdp1 
    3558                    WRITE(numout,*) 'Explored +1 Basin ID :', basin_id(dp1,1:basin_count(dp1)) 
    3559                    WRITE(numout,*) 'Explored +1 hierarchies :', basin_hierarchy(dp1,1:basin_count(dp1)) 
    3560                    WRITE(numout,*) 'Explored +1 basin_flowdir :', basin_flowdir(dp1,1:basin_count(dp1)) 
    3561                    WRITE(numout,*) 'Explored options -1 :', dm1, bm1, outdm1 
    3562                    WRITE(numout,*) 'Explored -1 Basin ID :', basin_id(dm1,1:basin_count(dm1)) 
    3563                    WRITE(numout,*) 'Explored -1 hierarchies :', basin_hierarchy(dm1,1:basin_count(dm1)) 
    3564                    WRITE(numout,*) 'Explored -1 basin_flowdir :', basin_flowdir(dm1,1:basin_count(dm1)) 
    3565                    WRITE(numout,*) '****************************' 
     3565                   IF (check) THEN 
     3566                      WRITE(numout,*) 'Why are we here with point ', sp, sb 
     3567                      WRITE(numout,*) 'Coodinates : (lon,lat) = ', lalo(sp,2), lalo(sp,1) 
     3568                      WRITE(numout,*) 'Contfrac : = ', contfrac(sp) 
     3569                      WRITE(numout,*) 'Local Basin ID :', basin_id(sp,1:basin_count(sp)) 
     3570                      WRITE(numout,*) 'Local hierarchies :', basin_hierarchy(sp,1:basin_count(sp)) 
     3571                      WRITE(numout,*) 'Local basin_flowdir :', basin_flowdir(sp,1:basin_count(sp)) 
     3572                      WRITE(numout,*) 'Local outflowgrid :', outflow_grid(sp,1:basin_count(sp)) 
     3573                      WRITE(numout,*) 'outflow_grid :', inp 
     3574                      WRITE(numout,*) 'Coodinates outflow : (lon,lat) = ', lalo(inp,2), lalo(inp,1) 
     3575                      WRITE(numout,*) 'Contfrac : = ', contfrac(inp) 
     3576                      WRITE(numout,*) 'Outflow Basin ID :', basin_id(inp,1:basin_count(inp)) 
     3577                      WRITE(numout,*) 'Outflow hierarchies :', basin_hierarchy(inp,1:basin_count(inp)) 
     3578                      WRITE(numout,*) 'Outflow basin_flowdir :', basin_flowdir(inp,1:basin_count(inp)) 
     3579                      WRITE(numout,*) 'Explored options +1 :', dp1, bp1, outdp1 
     3580                      WRITE(numout,*) 'Explored +1 Basin ID :', basin_id(dp1,1:basin_count(dp1)) 
     3581                      WRITE(numout,*) 'Explored +1 hierarchies :', basin_hierarchy(dp1,1:basin_count(dp1)) 
     3582                      WRITE(numout,*) 'Explored +1 basin_flowdir :', basin_flowdir(dp1,1:basin_count(dp1)) 
     3583                      WRITE(numout,*) 'Explored options -1 :', dm1, bm1, outdm1 
     3584                      WRITE(numout,*) 'Explored -1 Basin ID :', basin_id(dm1,1:basin_count(dm1)) 
     3585                      WRITE(numout,*) 'Explored -1 hierarchies :', basin_hierarchy(dm1,1:basin_count(dm1)) 
     3586                      WRITE(numout,*) 'Explored -1 basin_flowdir :', basin_flowdir(dm1,1:basin_count(dm1)) 
     3587                      WRITE(numout,*) '****************************' 
     3588                   ENDIF 
    35663589                   IF ( contfrac(sp) > 0.01 ) THEN 
    3567                       CALL ipslerr(3,'routing_linkup', & 
    3568                         &      'In the routine which make connections between the basins and ensure global coherence,', &  
    3569                         &      'there is a problem with outflow linkup without any valid direction.', & 
    3570                         &      '(Perhaps there is a problem with the grid.)') 
     3590                      error2=.TRUE. 
     3591                      EXIT 
    35713592                   ENDIF 
    35723593                ENDIF 
     
    35853606                   inflow_basin(dop, bop, inflow_number(dop,bop)) = sb 
    35863607                ELSE 
    3587                    WRITE(numout,*) 'Increase nbvmax' 
    3588                    STOP 'routing_linkup' 
     3608                   error3=.TRUE. 
     3609                   EXIT 
    35893610                ENDIF 
    35903611                ! 
     
    36053626             ! 
    36063627              
    3607              WRITE(numout,*) 'There is no reason to here, this part of the code should be dead :', sp,sb 
    3608               
     3628             IF (check) & 
     3629                  WRITE(numout,*) 'There is no reason to here, this part of the code should be dead :', sp,sb 
    36093630             ! 
    36103631             DO sbl=1,basin_count(sp) 
     
    36223643                   IF ( inflow_number(sp,sbl) .LE. nbvmax ) THEN 
    36233644                      IF ( sp .EQ. 42 .AND. sbl .EQ. 1) THEN 
    3624                          WRITE(numout,*) 'ADD INFLOW (3):', sp, sb 
     3645                         IF (check) & 
     3646                              WRITE(numout,*) 'ADD INFLOW (3):', sp, sb 
    36253647                      ENDIF 
    36263648                      inflow_grid(sp, sbl, inflow_number(sp,sbl)) = sp 
    36273649                      inflow_basin(sp, sbl, inflow_number(sp,sbl)) = sb 
    36283650                   ELSE 
    3629                       WRITE(numout,*) 'Increase nbvmax' 
    3630                       STOP 'routing_linkup' 
     3651                      error4=.TRUE. 
     3652                      EXIT 
    36313653                   ENDIF 
    36323654                ENDIF 
     
    36393661               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN 
    36403662             ! 
    3641              WRITE(numout,*) 'We could not find the basin into which we need to flow' 
    3642              WRITE(numout,*) 'Grid point ', sp, ' and basin ', sb 
    3643              WRITE(numout,*) 'Explored neighbours :', dm1, dp1  
    3644              WRITE(numout,*) 'Outflow direction :', basin_flowdir(sp,sb) 
    3645              WRITE(numout,*) 'Outlfow grid :', outflow_grid(sp,sb) 
    3646              WRITE(numout,*) 'basin ID:',basin_id(sp,sb) 
    3647              WRITE(numout,*) 'Hierarchy :', basin_hierarchy(sp,sb) 
    3648              STOP 'routing_linkup' 
     3663             error5=.TRUE. 
     3664             EXIT 
    36493665          ENDIF 
    36503666       ENDDO 
    36513667       ! 
    36523668    ENDDO 
     3669    IF (error1) THEN 
     3670       WRITE(numout,*) " routing_linkup : bop .LT. undef_int",bop 
     3671       CALL ipslerr(3,'routing_linkup', & 
     3672            "bop .LT. undef_int",'Increase nbvmax','stop routing_linkup') 
     3673    ENDIF 
     3674    IF (error2) THEN 
     3675       CALL ipslerr(3,'routing_linkup', & 
     3676            &      'In the routine which make connections between the basins and ensure global coherence,', &  
     3677            &      'there is a problem with outflow linkup without any valid direction. Try with check=.TRUE.', & 
     3678            &      '(Perhaps there is a problem with the grid.)') 
     3679    ENDIF 
     3680    IF (error3) THEN 
     3681       WRITE(numout,*) " routing_linkup : dop .GT. 0 .AND. dop .NE. undef_int",dop 
     3682       CALL ipslerr(3,'routing_linkup', & 
     3683            "dop .GT. 0 .AND. dop .NE. undef_int",'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup') 
     3684    ENDIF 
     3685    IF (error4) THEN 
     3686       WRITE(numout,*) " routing_linkup : (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) ", &  
     3687            &  " .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))",sbl,sb,basin_id(sp,sbl),bid, &  
     3688            &  basin_hierarchy(sp,sb),basin_hierarchy(sp,sbl) 
     3689       CALL ipslerr(3,'routing_linkup', & 
     3690            "(sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))" & 
     3691            ,'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup') 
     3692    ENDIF 
     3693    IF (error5) THEN 
     3694       WRITE(numout,*) 'We could not find the basin into which we need to flow' 
     3695       WRITE(numout,*) 'Grid point ', sp, ' and basin ', sb 
     3696       WRITE(numout,*) 'Explored neighbours :', dm1, dp1  
     3697       WRITE(numout,*) 'Outflow direction :', basin_flowdir(sp,sb) 
     3698       WRITE(numout,*) 'Outlfow grid :', outflow_grid(sp,sb) 
     3699       WRITE(numout,*) 'Outlfow basin :',outflow_basin(sp,sb) 
     3700       WRITE(numout,*) 'basin ID:',basin_id(sp,sb) 
     3701       WRITE(numout,*) 'Hierarchy :', basin_hierarchy(sp,sb) 
     3702       CALL ipslerr(3,'routing_linkup', & 
     3703            "We could not find the basin into which we need to flow",'Try with check=.TRUE.','stop routing_linkup') 
     3704    ENDIF 
    36533705    ! 
    36543706    ! Check for each outflow basin that it exists 
     
    37243776    ! Compute the area upstream of each basin 
    37253777    ! 
    3726     fetch_basin(:,:) = 0.0 
     3778    fetch_basin(:,:) = zero 
    37273779    ! 
    37283780    ! 
     
    37933845       ff = MAXLOC(tmp_area(1:nboutflow)) 
    37943846       outflow_grid(tmpindex(ff(1),1), tmpindex(ff(1),2)) = -1 
    3795        tmp_area(ff(1)) = 0.0 
     3847       tmp_area(ff(1)) = zero 
    37963848    ENDDO 
    37973849    ! 
     
    39443996             ! Now the take the smalest to be transfered to the largest 
    39453997             ! 
    3946              iml = MAXLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. 0.) 
     3998             iml = MAXLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero) 
    39473999             sbas = multbas_sz(iml(1)) 
    3948              iml = MINLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. 0.) 
     4000             iml = MINLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero) 
    39494001             kbas = multbas_sz(iml(1)) 
    39504002             ! 
     
    39914043                   tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii)) 
    39924044                ENDDO 
    3993                 iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. 0.) 
     4045                iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero) 
    39944046                sbas = multbas_list(ik,iml(1)) 
    3995                 iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. 0.) 
     4047                iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero) 
    39964048                kbas = multbas_list(ik,iml(1)) 
    39974049                ! 
     
    40374089                ! If one of the basins goes to the ocean then it is going to have the priority 
    40384090                ! 
    4039                 tmp_area(:) = 0. 
     4091                tmp_area(:) = zero 
    40404092                IF ( COUNT(outflow_grid(ib,multbas_list(ik,1:multbas_sz(ik))) .LT. 0) .GT. 0) THEN 
    40414093                   DO ii=1,multbas_sz(ik) 
     
    40474099                   ENDDO 
    40484100                   ! take the smalest of the subbasins 
    4049                    iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. 0.) 
     4101                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero) 
    40504102                   kbas = multbas_list(ik,iml(1)) 
    40514103                ELSE 
     
    40564108                      tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii)) 
    40574109                   ENDDO 
    4058                    iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. 0.) 
     4110                   iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero) 
    40594111                   sbas = multbas_list(ik,iml(1)) 
    4060                    iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. 0.) 
     4112                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero) 
    40614113                   kbas = multbas_list(ik,iml(1)) 
    40624114                   ! 
     
    41474199       route_togrid(ib,:) = ib 
    41484200       route_tobasin(ib,:) = 0 
    4149        routing_area(ib,:) = 0.0 
     4201       routing_area(ib,:) = zero 
    41504202       ! 
    41514203    ENDDO 
     
    42104262    ! Verify areas of the contienents 
    42114263    ! 
    4212     floflo(:,:) = 0.0 
     4264    floflo(:,:) = zero 
    42134265    gridarea(:) = contfrac(:)*resolution(:,1)*resolution(:,2) 
    42144266    DO ib=1,nbpt 
     
    42494301    ! 
    42504302    DO ib=1,nbpt 
    4251        IF ( gridbasinarea(ib) > 0. ) THEN 
     4303       IF ( gridbasinarea(ib) > zero ) THEN 
    42524304          ratio = gridarea(ib)/gridbasinarea(ib) 
    42534305          routing_area(ib,:) = routing_area(ib,:)*ratio 
     
    42684320          largest_basins(ibf,:) = ff(:) 
    42694321       ENDIF 
    4270        floflo(ff(1), ff(2)) = 0.0 
     4322       floflo(ff(1), ff(2)) = zero 
    42714323    ENDDO 
    42724324    ! 
     
    44054457    basin_flowdir(ib, tokill:basin_count(ib)-1) = basin_flowdir(ib, tokill+1:basin_count(ib)) 
    44064458    basin_area(ib, tokill:basin_count(ib)-1) = basin_area(ib, tokill+1:basin_count(ib)) 
    4407     basin_area(ib, basin_count(ib):nwbas) = 0.0 
     4459    basin_area(ib, basin_count(ib):nwbas) = zero 
    44084460    basin_topoind(ib, tokill:basin_count(ib)-1) = basin_topoind(ib, tokill+1:basin_count(ib)) 
    4409     basin_topoind(ib, basin_count(ib):nwbas) = 0.0 
     4461    basin_topoind(ib, basin_count(ib):nwbas) = zero 
    44104462    fetch_basin(ib, tokill:basin_count(ib)-1) = fetch_basin(ib, tokill+1:basin_count(ib)) 
    4411     fetch_basin(ib, basin_count(ib):nwbas) = 0.0 
     4463    fetch_basin(ib, basin_count(ib):nwbas) = zero 
    44124464    ! 
    44134465    ! Before we remove the information from the outflow fields we have to correct the corresponding inflow fields 
     
    49194971       DO jp=1,jml 
    49204972          ! 
    4921           IF ( irrigated_frac(ip,jp) .LT. undef_sechiba-1.) THEN 
     4973          IF ( irrigated_frac(ip,jp) .LT. undef_sechiba-un) THEN 
    49224974             irrigated_frac(ip,jp) = irrigated_frac(ip,jp)/100. 
    4923              IF ( irrigated_frac(ip,jp) < 0.005 ) irrigated_frac(ip,jp) = 0.0 
     4975             IF ( irrigated_frac(ip,jp) < 0.005 ) irrigated_frac(ip,jp) = zero 
    49244976          ENDIF 
    49254977          ! 
    4926           IF ( flood_frac(ip,jp) .LT. undef_sechiba-1.) THEN 
     4978          IF ( flood_frac(ip,jp) .LT. undef_sechiba-un) THEN 
    49274979             flood_frac(ip,jp) = flood_frac(ip,jp)/100 
    4928              IF ( flood_frac(ip,jp) < 0.005 )  flood_frac(ip,jp) = 0.0 
     4980             IF ( flood_frac(ip,jp) < 0.005 )  flood_frac(ip,jp) = zero 
    49294981          ENDIF 
    49304982          ! 
     
    50825134                   ENDIF 
    50835135                   ! 
    5084                    IF (flood_frac(ip,jp) .LT. undef_sechiba-1.) THEN 
     5136                   IF (flood_frac(ip,jp) .LT. undef_sechiba-un) THEN 
    50855137                      area_flood = area_flood + ax*ay*flood_frac(ip,jp) 
    50865138                   ENDIF                       
     
    51055157          ENDIF 
    51065158          ! Compute a diagnostic of the map. 
    5107           IF(contfrac(ib).GT.0.0) THEN 
     5159          IF(contfrac(ib).GT.zero) THEN 
    51085160             irrigmap (ib) = irrigated(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) ) 
    51095161          ELSE 
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/sechiba.f90

    r257 r277  
    44!! 
    55!! @author Marie-Alice Foujols and Jan Polcher 
    6 !! @Version : $Revision: 45 $, $Date: 2011-01-01 21:30:44 +0100 (Sat, 01 Jan 2011) $ 
     6!! @Version : $Revision: 275 $, $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 
    77!!  
    88!< $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!< $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 
     10!< $Author: martial.mancip $ 
     11!< $Revision: 275 $ 
    1212!! IPSL (2006) 
    1313!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC 
     
    186186    & precip_rain, precip_snow, lwdown, swnet, swdown, pb, & 
    187187         ! Output : Fluxes 
    188     & vevapp, fluxsens, fluxlat, coastalflow, riverflow, & 
     188    & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2flux, fco2_lu, & 
    189189         ! Surface temperatures and surface properties 
    190190    & tsol_rad, temp_sol_new, qsurf_out, albedo_out, emis_out, z0_out, & 
     
    249249    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat          !! Latent chaleur flux 
    250250    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out         !! Emissivity 
     251    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux       !! Sum CO2 flux over PFTs (gC/m**2 of average ground/s) 
     252    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu          !! Land Cover Change CO2 flux (gC/m**2 of average ground/s) 
    251253 
    252254    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: runoff1,drainage1, soilcap1,soilflx1 
     
    322324            lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    323325            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    324             co2_flux) 
     326            co2_flux, fco2_lu) 
     327       netco2flux(:) = zero 
     328       DO jv = 2,nvm 
     329          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     330       ENDDO 
    325331       !  
    326332       ! computes initialisation of diffusion coeff 
     
    570576         lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    571577         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    572          co2_flux) 
    573  
     578         co2_flux, fco2_lu) 
     579    ! 
     580    ! Compute global CO2 flux 
     581    ! 
     582    netco2flux(:) = zero 
     583    DO jv = 2,nvm 
     584       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     585    ENDDO 
    574586    ! 
    575587    ! call swap from new computed variables   
     
    831843            lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    832844            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    833             co2_flux) 
    834  
     845            co2_flux, fco2_lu) 
     846       netco2flux(:) = zero 
     847       DO jv = 2,nvm 
     848          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv) 
     849       ENDDO 
    835850 
    836851       var_name= 'shumdiag'   
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/slowproc.f90

    r257 r277  
    33! 
    44!< $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!< $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 
     6!< $Author: martial.mancip $ 
     7!< $Revision: 275 $ 
    88!! IPSL (2006) 
    99!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC 
     
    7878       lai, height, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, & 
    7979       rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    80        co2_flux) 
     80       co2_flux, fco2_lu) 
    8181 
    8282 
     
    117117    ! output fields 
    118118    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)      :: co2_flux         !! CO2 flux in gC/m**2 of average ground/second 
     119    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: fco2_lu          !! Land Cover Change CO2 flux (gC/m**2 of average ground/s) 
    119120    ! modified scalar 
    120121    ! modified fields 
     
    190191               veget_nextyear, totfrac_nobio_nextyear, & 
    191192               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    192                co2_flux,resp_maint,resp_hetero,resp_growth) 
     193               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    193194          ! 
    194195       ENDIF 
     
    286287               veget_nextyear, totfrac_nobio_nextyear, & 
    287288               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    288                co2_flux,resp_maint,resp_hetero,resp_growth) 
     289               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    289290       ENDIF 
    290291 
     
    384385            veget_nextyear, totfrac_nobio_nextyear, & 
    385386            hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    386             co2_flux,resp_maint,resp_hetero,resp_growth) 
     387            co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    387388       IF ( control%ok_stomate .AND. control%ok_sechiba ) THEN 
    388389          CALL histwrite(hist_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg) 
     
    756757    CALL getin_p ("HYDROL_SOIL_DEPTH", dpu_cste) 
    757758    dpu(:)=dpu_cste 
    758     ! 
    759     !Config Key  = HYDROL_HUMCSTE 
    760     !Config Desc = Root profile 
    761     !Config Def  = 5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4. 
    762     !Config Help = Default values were defined for 2 meters soil depth. 
    763     !Config        For 4 meters soil depth, you may use those ones : 
    764     !Config        5., .4, .4, 1., .8, .8, 1., 1., .8, 4., 1., 4., 1. 
    765     ! 
    766 !    humcste(:)= & 
    767 !         & (/5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4./) 
    768 !!$    CALL getin_p ("HYDROL_HUMCSTE", humcste) 
    769  
    770759!MM, T. d'O. : before in constantes_soil : 
    771760!          diaglev = & 
     
    29172906    ! 
    29182907    IF (MAXVAL(vegmap) .LT. nolson) THEN 
    2919       WRITE(*,*) 'WARNING -- WARNING' 
    2920       WRITE(*,*) 'The vegetation map has to few vegetation types.' 
    2921       WRITE(*,*) 'If you are lucky it will work but please check' 
     2908       WRITE(*,*) 'WARNING -- WARNING' 
     2909       WRITE(*,*) 'The vegetation map has to few vegetation types.' 
     2910       WRITE(*,*) 'If you are lucky it will work but please check' 
    29222911    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN 
    2923       WRITE(*,*) 'More vegetation types in file than the code can' 
    2924       WRITE(*,*) 'deal with.: ',  MAXVAL(vegmap),  nolson 
    2925       STOP 'slowproc_interpol' 
     2912       WRITE(*,*) 'More vegetation types in file than the code can' 
     2913       WRITE(*,*) 'deal with.: ',  MAXVAL(vegmap),  nolson 
     2914       STOP 'slowproc_interpol' 
    29262915    ENDIF 
    29272916    ! 
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate.f90

    r257 r277  
    328328       &  veget_max_new, totfrac_nobio_new, & 
    329329       &  hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, & 
    330        &  co2_flux,resp_maint,resp_hetero,resp_growth) 
     330       &  co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth) 
    331331    !--------------------------------------------------------------------- 
    332332    ! 
     
    418418    !NV champs 2D  
    419419    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)      :: co2_flux 
     420    REAL(r_std),DIMENSION(kjpindex),INTENT(out)      :: fco2_lu 
    420421    ! autotrophic respiration in gC/m**2 of surface/dt 
    421422    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: resp_maint 
     
    598599       ! 
    599600       ! 1.3.1 read STOMATE's start file 
     601       ! 
     602       co2_flux(:,:) = zero 
     603       fco2_lu(:) = zero 
    600604       ! 
    601605       CALL readstart & 
     
    13371341               &             fpc_max) 
    13381342 
     1343          ! 
     1344          ! fco2_lu --> luccarb 
     1345          fco2_lu(:) = convflux(:) & 
     1346               &             + cflux_prod10(:)  & 
     1347               &             + cflux_prod100(:) & 
     1348               &             + harvest_above(:) 
    13391349          ! 
    13401350          ! 6.4 output: transform from dimension nvm to dimension nvm 
Note: See TracChangeset for help on using the changeset viewer.