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

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

Location:
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba
Files:
4 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    ! 
Note: See TracChangeset for help on using the changeset viewer.