!$Id !! ========================================================================= !! INCA - INteraction with Chemistry and Aerosols !! !! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE) !! Unite mixte CEA-CNRS-UVSQ !! !! Contributors to this INCA subroutine: !! !! !! Anne Cozic, LSCE, anne.cozic@cea.fr !! Juliette Lathiere, LSCE, juliette.lathiere@cea.fr !! !! This software is a computer program whose purpose is to simulate the !! atmospheric gas phase and aerosol composition. The model is designed to be !! used within a transport model or a general circulation model. This version !! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts !! for emissions, transport (resolved and sub-grid scale), photochemical !! transformations, and scavenging (dry deposition and washout) of chemical !! species and aerosols interactively in the GCM. Several versions of the INCA !! model are currently used depending on the envisaged applications with the !! chemistry-climate model. !! !! This software is governed by the CeCILL license under French law and !! abiding by the rules of distribution of free software. You can use, !! modify and/ or redistribute the software under the terms of the CeCILL !! license as circulated by CEA, CNRS and INRIA at the following URL !! "http://www.cecill.info". !! !! As a counterpart to the access to the source code and rights to copy, !! modify and redistribute granted by the license, users are provided only !! with a limited warranty and the software's author, the holder of the !! economic rights, and the successive licensors have only limited !! liability. !! !! In this respect, the user's attention is drawn to the risks associated !! with loading, using, modifying and/or developing or reproducing the !! software by the user in light of its specific status of free software, !! that may mean that it is complicated to manipulate, and that also !! therefore means that it is reserved for developers and experienced !! professionals having in-depth computer knowledge. Users are therefore !! encouraged to load and test the software's suitability as regards their !! requirements in conditions enabling the security of their systems and/or !! data to be ensured and, more generally, to use and operate it in the !! same conditions as regards security. !! !! The fact that you are presently reading this means that you have had !! knowledge of the CeCILL license and that you accept its terms. !! ========================================================================= #include SUBROUTINE SURF_CHEM_ATM(pctsrf,fraction_landuse) USE CONST_LMDZ USE MOD_GRID_INCA USE MOD_INCA_MPI_DATA USE SURF_CHEM_MOD USE MOD_INCA_MPI_TRANSFERT USE SECHIBA USE PRINT_INCA USE PARAM_CHEM USE DRYDEP_PARAMETERS, ONLY : n_land_type IMPLICIT NONE ! REAL, INTENT(in) :: pctsrf(PLON,nbsrf) REAL, INTENT(out) :: fraction_landuse(PLON,n_land_type) ! local INTEGER :: knon, i, j, knon_orch INTEGER :: nvm_orch LOGICAL, SAVE :: first= .TRUE. !$OMP THREADPRIVATE(first) ! variables pour le changement de grille INTEGER , DIMENSION(PLON) :: knindex, ktindex_orch INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex !$OMP THREADPRIVATE(ktindex) INTEGER, SAVE :: orch_comm !$OMP THREADPRIVATE(orch_comm) INTEGER,SAVE :: offset !$OMP THREADPRIVATE(offset) ! variables pour le transfert de variables REAL, SAVE,allocatable, DIMENSION(:,:) :: veget_tmp !$OMP THREADPRIVATE(veget_tmp) REAL, SAVE,allocatable, DIMENSION(:,:) :: lai_tmp !$OMP THREADPRIVATE(lai_tmp) REAL, SAVE,allocatable, DIMENSION(:,:) :: vegetfrac_tmp !$OMP THREADPRIVATE(vegetfrac_tmp) REAL, SAVE,allocatable, DIMENSION(:) :: snow_tmp !$OMP THREADPRIVATE(snow_tmp) REAL, SAVE,allocatable, DIMENSION(:) :: hdry_tmp !$OMP THREADPRIVATE(hdry_tmp) REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: emission_tmp !$OMP THREADPRIVATE(emission_tmp) ! Search for index(knindex) and size(knon) of domaine to treat knindex(:) = 0 knon = 0 DO i = 1, PLON IF (pctsrf(i,is_ter) > 0.) THEN knon = knon + 1 knindex(knon) = i ENDIF ENDDO IF (first) THEN IF (nb_flux .NE. 0) then ALLOCATE(emission_tmp(knon,nbveget,nb_flux)) ENDIF ALLOCATE(veget_tmp(knon,nbveget)) ALLOCATE(lai_tmp(knon,nbveget)) ALLOCATE(vegetfrac_tmp(knon,nbveget)) ALLOCATE(snow_tmp(knon)) ALLOCATE(hdry_tmp(knon)) ALLOCATE(maxvegetfrac_fromOrch(PLON,nbveget)) maxvegetfrac_fromOrch(:,:) = 0 ALLOCATE(lai_fromOrch(PLON,nbveget)) lai_fromOrch(:,:) = 0 ALLOCATE(surftype_frac(PLON,nbsurf)) surftype_frac(:,:) = 0 ALLOCATE(vegetfrac_fromOrch(PLON,nbveget)) vegetfrac_fromOrch(:,:) = 0 ALLOCATE(snow_fromOrch(PLON)) snow_fromOrch(:) = 0 ALLOCATE(hdry_fromOrch(PLON)) hdry_fromOrch(:) = 0 DO i=1,PLON IF (pctsrf(i,is_oce) > 0.) surftype_frac(i,14) = pctsrf(i,is_oce) IF (pctsrf(i,is_sic) > 0.) surftype_frac(i,15) = pctsrf(i,is_sic) IF (pctsrf(i,is_lic) > 0.) surftype_frac(i,16) = pctsrf(i,is_lic) ENDDO first = .FALSE. ENDIF emission_tmp(:,:,:) = 0. veget_tmp(:,:) = 0. lai_tmp(:,:) = 0. vegetfrac_tmp(:,:) = 0. snow_tmp(:) = 0. hdry_tmp(:) = 0. IF (knon /=0 ) THEN IF (nb_flux .NE. 0) THEN CALL sechiba_interface_orchidee_inca(nvm_orch,veget_tmp(1:knon,:), vegetfrac_tmp(1:knon, :), & lai_tmp(1:knon,:), snow_tmp(1:knon), field_out_names=field_emi_names, fields_out=emission_tmp) ELSE CALL sechiba_interface_orchidee_inca(nvm_orch,veget_tmp(1:knon,:), vegetfrac_tmp(1:knon, :), & lai_tmp(1:knon,:), snow_tmp(1:knon)) ENDIF IF (nvm_orch .ne. nbveget ) THEN WRITE(lunout, *) '[nbveget in INCA] [nbveget in ORCHIDEE]', nbveget, nvm_orch call print_err(3, 'SURF_CHEM_ATM',' nbveget incorrect in inca.def', 'check nbveget is not consistant with orchidee value', '') endif ELSE nvm_orch = 0 ENDIF DO j=1,knon i = knindex(j) ! On fait la ponderation sur la fraction de terre dans mksflx maxvegetfrac_fromOrch(i,:) = veget_tmp(j,:) vegetfrac_fromOrch(i,:) = vegetfrac_tmp(j,:) lai_fromOrch(i,:) = lai_tmp(j,:) snow_fromOrch(i) = snow_tmp(j) ! hdry_fromOrch(i) = hdry_tmp(j) surftype_frac(i,1:nbveget) = veget_tmp(j,:)*pctsrf(i,is_ter) IF (nb_flux .NE. 0) THEN emiflx_fromOrch(i,:,:) = emission_tmp(j,:,:) ENDIF ENDDO IF (nb_flux .NE. 0) THEN CALL Surf_weightedflx() ENDIF ! choix du depot IF (dep_orch) THEN IF (n_land_type .EQ. nbsurf) THEN fraction_landuse(:,:) = surftype_frac(:,:) * 100 ELSE CALL print_err(3, 'SURF_CHEM_ATM','There is a problem of dimension ', & 'check n_land_type and nbsurf', 'dep_orch can be activate only if n_land_type = nbsurf') ENDIF ENDIF END SUBROUTINE SURF_CHEM_ATM