Changeset 277 for branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90
- Timestamp:
- 2011-06-23T11:25:25+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90
r257 r277 7 7 !! 8 8 !! @call sechiba_main 9 !! @Version : $Revision: 2 21 $, $Date: 2011-05-16 17:26:17 +0200 (Mon, 16 May2011) $9 !! @Version : $Revision: 275 $, $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 10 10 !! 11 11 !! @author Marie-Alice Foujols and Jan Polcher 12 12 !! 13 13 !< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/intersurf.f90 $ 14 !< $Date: 2011-0 5-16 17:26:17 +0200 (Mon, 16 May2011) $14 !< $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $ 15 15 !< $Author: martial.mancip $ 16 !< $Revision: 2 21$16 !< $Revision: 275 $ 17 17 !! IPSL (2006) 18 18 !! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC … … 162 162 REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastalflow 163 163 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 164 166 REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad 165 167 REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp … … 357 359 & zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zpb, & 358 360 ! Output : Fluxes 359 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &361 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 360 362 ! Surface temperatures and surface properties 361 363 & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & … … 701 703 REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow 702 704 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 703 707 REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad 704 708 REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp … … 874 878 & zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zpb, & 875 879 ! Output : Fluxes 876 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &880 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 877 881 ! Surface temperatures and surface properties 878 882 & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & … … 1211 1215 REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow 1212 1216 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 1213 1219 REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad 1214 1220 REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp … … 1571 1577 & zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, pb, & 1572 1578 ! Output : Fluxes 1573 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &1579 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 1574 1580 ! Surface temperatures and surface properties 1575 1581 & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & … … 1850 1856 & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 1851 1857 ! 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) 1853 1861 #else 1854 1862 SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, & … … 1866 1874 & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, & 1867 1875 ! 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) 1869 1879 #endif 1870 1880 ! routines called : sechiba_main … … 1925 1935 REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux 1926 1936 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 ! 1927 1948 ! LOCAL declaration 1928 1949 ! work arrays to scatter and/or gather information just before/after sechiba_main call's … … 1937 1958 REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow 1938 1959 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 1939 1962 REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad 1940 1963 REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp … … 1948 1971 ! Optional arguments 1949 1972 ! 1950 REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) , OPTIONAL:: lon_scat_g, lat_scat_g !! The scattered values for longitude1973 REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g, lat_scat_g !! The scattered values for longitude 1951 1974 ! 1952 1975 INTEGER(i_std) :: iim,jjm !! local sizes … … 1980 2003 LOGICAL, SAVE :: fatmco2 !! Flag to force the value of atmospheric CO2 for vegetation. 1981 2004 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 1982 2010 ! 1983 2011 CALL ipslnlf(old_number=old_fileout) … … 2063 2091 ! we have to do the work here. 2064 2092 ! 2065 IF ( PRESENT(lon_scat_g) .AND. PRESENT(lat_scat_g)) THEN2093 IF ( .TRUE. ) THEN 2066 2094 2067 2095 lon_scat(:,:)=zero … … 2081 2109 lat_g(:,:) = lat_scat_g(:,:) 2082 2110 ENDIF 2083 2084 ELSE IF ( PRESENT(lon_scat_g) .OR. PRESENT(lat_scat_g)) THEN2085 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'2089 2111 2090 2112 ELSE … … 2198 2220 ENDIF 2199 2221 ! 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 2200 2235 IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf' 2201 2236 ! … … 2251 2286 WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac 2252 2287 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 2253 2305 ! 2254 2306 ! 2. modification of co2 … … 2301 2353 & zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, pb, & 2302 2354 ! Output : Fluxes 2303 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &2355 & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, & 2304 2356 ! Surface temperatures and surface properties 2305 2357 & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, & … … 2553 2605 riverflow(ik) = riverflow(ik)/xrdt 2554 2606 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 2555 2625 ENDDO 2556 2626 !
Note: See TracChangeset
for help on using the changeset viewer.
