source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/build/ppsrc/INCA_VEG/surf_chem_atm.f90 @ 6610

Last change on this file since 6610 was 6610, checked in by acosce, 10 months ago

INCA used for ICOLMDZORINCA_CO2_Transport_GMD_2023

File size: 7.1 KB
Line 
1
2
3
4
5
6
7
8
9
10
11
12!$Id
13!! =========================================================================
14!! INCA - INteraction with Chemistry and Aerosols
15!!
16!! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE)
17!!           Unite mixte CEA-CNRS-UVSQ
18!!
19!! Contributors to this INCA subroutine:
20!!
21!!
22!! Anne Cozic, LSCE, anne.cozic@cea.fr
23!! Juliette Lathiere, LSCE, juliette.lathiere@cea.fr
24!!
25!! This software is a computer program whose purpose is to simulate the
26!! atmospheric gas phase and aerosol composition. The model is designed to be
27!! used within a transport model or a general circulation model. This version
28!! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts
29!! for emissions, transport (resolved and sub-grid scale), photochemical
30!! transformations, and scavenging (dry deposition and washout) of chemical
31!! species and aerosols interactively in the GCM. Several versions of the INCA
32!! model are currently used depending on the envisaged applications with the
33!! chemistry-climate model.
34!!
35!! This software is governed by the CeCILL  license under French law and
36!! abiding by the rules of distribution of free software.  You can  use,
37!! modify and/ or redistribute the software under the terms of the CeCILL
38!! license as circulated by CEA, CNRS and INRIA at the following URL
39!! "http://www.cecill.info".
40!!
41!! As a counterpart to the access to the source code and  rights to copy,
42!! modify and redistribute granted by the license, users are provided only
43!! with a limited warranty  and the software's author,  the holder of the
44!! economic rights,  and the successive licensors  have only  limited
45!! liability.
46!!
47!! In this respect, the user's attention is drawn to the risks associated
48!! with loading,  using,  modifying and/or developing or reproducing the
49!! software by the user in light of its specific status of free software,
50!! that may mean  that it is complicated to manipulate,  and  that  also
51!! therefore means  that it is reserved for developers  and  experienced
52!! professionals having in-depth computer knowledge. Users are therefore
53!! encouraged to load and test the software's suitability as regards their
54!! requirements in conditions enabling the security of their systems and/or
55!! data to be ensured and,  more generally, to use and operate it in the
56!! same conditions as regards security.
57!!
58!! The fact that you are presently reading this means that you have had
59!! knowledge of the CeCILL license and that you accept its terms.
60!! =========================================================================
61
62
63SUBROUTINE SURF_CHEM_ATM(pctsrf,fraction_landuse)
64
65  USE CONST_LMDZ
66  USE MOD_GRID_INCA
67  USE MOD_INCA_MPI_DATA
68  USE SURF_CHEM_MOD
69  USE MOD_INCA_MPI_TRANSFERT
70  USE SECHIBA
71  USE PRINT_INCA
72  USE PARAM_CHEM
73  USE DRYDEP_PARAMETERS, ONLY : n_land_type
74
75
76  IMPLICIT NONE
77
78
79  !
80  REAL,  INTENT(in)    :: pctsrf(PLON,nbsrf)         
81  REAL, INTENT(out)    :: fraction_landuse(PLON,n_land_type) 
82
83  ! local
84  INTEGER :: knon, i, j, knon_orch
85  INTEGER :: nvm_orch
86  LOGICAL, SAVE :: first= .TRUE. 
87!$OMP THREADPRIVATE(first)
88
89  ! variables pour le changement de grille
90  INTEGER , DIMENSION(PLON) :: knindex, ktindex_orch
91  INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
92!$OMP THREADPRIVATE(ktindex)
93  INTEGER, SAVE :: orch_comm
94!$OMP THREADPRIVATE(orch_comm)
95  INTEGER,SAVE :: offset
96!$OMP THREADPRIVATE(offset)
97
98  ! variables pour le transfert de variables
99  REAL, SAVE,allocatable, DIMENSION(:,:) :: veget_tmp
100!$OMP THREADPRIVATE(veget_tmp)
101  REAL, SAVE,allocatable, DIMENSION(:,:) :: lai_tmp
102!$OMP THREADPRIVATE(lai_tmp)
103  REAL, SAVE,allocatable, DIMENSION(:,:) :: vegetfrac_tmp
104!$OMP THREADPRIVATE(vegetfrac_tmp)
105  REAL, SAVE,allocatable, DIMENSION(:) :: snow_tmp
106!$OMP THREADPRIVATE(snow_tmp)
107  REAL, SAVE,allocatable, DIMENSION(:) :: hdry_tmp
108!$OMP THREADPRIVATE(hdry_tmp)
109  REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: emission_tmp
110!$OMP THREADPRIVATE(emission_tmp)
111 
112 
113  ! Search for index(knindex) and size(knon) of domaine to treat
114  knindex(:) = 0
115  knon  = 0
116  DO i = 1, PLON
117    IF (pctsrf(i,is_ter) > 0.) THEN
118        knon = knon + 1
119        knindex(knon) = i
120    ENDIF
121  ENDDO
122
123
124  IF (first) THEN
125
126      IF (nb_flux .NE. 0) then
127         ALLOCATE(emission_tmp(knon,nbveget,nb_flux))
128      ENDIF
129      ALLOCATE(veget_tmp(knon,nbveget))
130      ALLOCATE(lai_tmp(knon,nbveget))
131      ALLOCATE(vegetfrac_tmp(knon,nbveget))
132      ALLOCATE(snow_tmp(knon))
133      ALLOCATE(hdry_tmp(knon))
134
135      ALLOCATE(maxvegetfrac_fromOrch(PLON,nbveget))
136      maxvegetfrac_fromOrch(:,:) = 0
137
138      ALLOCATE(lai_fromOrch(PLON,nbveget)) 
139      lai_fromOrch(:,:) = 0 
140
141
142      ALLOCATE(surftype_frac(PLON,nbsurf))
143      surftype_frac(:,:) = 0
144
145      ALLOCATE(vegetfrac_fromOrch(PLON,nbveget))
146      vegetfrac_fromOrch(:,:) = 0
147
148      ALLOCATE(snow_fromOrch(PLON))
149      snow_fromOrch(:) = 0
150
151      ALLOCATE(hdry_fromOrch(PLON))
152      hdry_fromOrch(:) = 0 
153
154      DO i=1,PLON
155        IF (pctsrf(i,is_oce) > 0.) surftype_frac(i,14) = pctsrf(i,is_oce)
156        IF (pctsrf(i,is_sic) > 0.) surftype_frac(i,15) = pctsrf(i,is_sic)
157        IF (pctsrf(i,is_lic) > 0.) surftype_frac(i,16) = pctsrf(i,is_lic)
158      ENDDO
159     
160      first = .FALSE. 
161 
162  ENDIF
163
164      emission_tmp(:,:,:) = 0.
165      veget_tmp(:,:) = 0.
166      lai_tmp(:,:) = 0. 
167      vegetfrac_tmp(:,:) = 0.
168      snow_tmp(:) = 0. 
169      hdry_tmp(:) = 0. 
170
171      IF (knon /=0 ) THEN
172         IF (nb_flux .NE. 0) THEN
173            CALL sechiba_interface_orchidee_inca(nvm_orch,veget_tmp(1:knon,:), vegetfrac_tmp(1:knon, :), &
174                 lai_tmp(1:knon,:), snow_tmp(1:knon), field_out_names=field_emi_names, fields_out=emission_tmp)
175         ELSE
176            CALL sechiba_interface_orchidee_inca(nvm_orch,veget_tmp(1:knon,:), vegetfrac_tmp(1:knon, :), &
177                 lai_tmp(1:knon,:), snow_tmp(1:knon))
178         ENDIF
179         IF (nvm_orch .ne. nbveget ) THEN
180            WRITE(lunout, *) '[nbveget in INCA] [nbveget in ORCHIDEE]', nbveget, nvm_orch
181            call print_err(3, 'SURF_CHEM_ATM',' nbveget incorrect in inca.def', 'check nbveget is not consistant with orchidee value', '')
182         endif
183
184      ELSE
185          nvm_orch = 0 
186      ENDIF
187
188      DO j=1,knon
189        i = knindex(j)
190
191        ! On fait la ponderation sur la fraction de terre dans mksflx
192        maxvegetfrac_fromOrch(i,:) = veget_tmp(j,:) 
193        vegetfrac_fromOrch(i,:) = vegetfrac_tmp(j,:)
194        lai_fromOrch(i,:) = lai_tmp(j,:)
195        snow_fromOrch(i) = snow_tmp(j) 
196!        hdry_fromOrch(i) = hdry_tmp(j)
197        surftype_frac(i,1:nbveget) = veget_tmp(j,:)*pctsrf(i,is_ter)
198
199        IF (nb_flux .NE. 0) THEN
200           emiflx_fromOrch(i,:,:) = emission_tmp(j,:,:) 
201        ENDIF
202
203      ENDDO
204
205
206      IF (nb_flux .NE. 0) THEN
207         CALL Surf_weightedflx() 
208      ENDIF
209
210
211      ! choix du depot
212      IF (dep_orch) THEN
213         IF (n_land_type .EQ. nbsurf) THEN
214            fraction_landuse(:,:) = surftype_frac(:,:) * 100
215         ELSE
216            CALL print_err(3, 'SURF_CHEM_ATM','There is a problem of dimension ', &
217                 'check n_land_type and nbsurf', 'dep_orch can be activate only if n_land_type = nbsurf')
218         ENDIF
219      ENDIF
220
221END SUBROUTINE SURF_CHEM_ATM
222
223
Note: See TracBrowser for help on using the repository browser.