source: LMDZ4/branches/LMDZ4-dev/libf/phylmd/traclmdz_mod.F90 @ 1226

Last change on this file since 1226 was 1212, checked in by jghattas, 15 years ago
  • Correction dans la recherche du traceur Berelium
  • Correction des messages d'erreurs
  • Enleve allocate pas necessaire
  • Ajoute argument d'entree pour traclmdz bientot necessaire (pour parametrization Cariolle)
File size: 10.9 KB
Line 
1!$Id $
2!
3MODULE traclmdz_mod
4!
5! In this module all tracers specific to LMDZ are treated. This module is used
6! only if running without any other chemestry model as INCA or REPROBUS. 
7!
8
9  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr   ! Masque reservoir de sol traceur
10!$OMP THREADPRIVATE(masktr)                        ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 )
11  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr    ! Flux surfacique dans le reservoir de sol
12!$OMP THREADPRIVATE(fshtr)
13  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: hsoltr   ! Epaisseur equivalente du reservoir de sol
14!$OMP THREADPRIVATE(hsoltr)
15!
16!Radioelements:
17!--------------
18!
19  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: tautr    ! Constante de decroissance radioactive
20!$OMP THREADPRIVATE(tautr)
21  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: vdeptr   ! Vitesse de depot sec dans la couche Brownienne
22!$OMP THREADPRIVATE(vdeptr)
23  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: scavtr   ! Coefficient de lessivage
24!$OMP THREADPRIVATE(scavtr)
25  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe    ! Production du beryllium7 dans l atmosphere (U/s/kgA)
26!$OMP THREADPRIVATE(srcbe)
27
28  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio    ! radio(it)   = true  => decroisssance radioactive
29!$OMP THREADPRIVATE(radio) 
30
31  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs     ! Conc. radon ds le sol
32!$OMP THREADPRIVATE(trs)
33
34  INTEGER,SAVE :: id_be       ! Activation et position du traceur Be7 [ id_be=0 -> desactive ]
35!$OMP THREADPRIVATE(id_be)
36
37  LOGICAL,SAVE :: rnpb=.TRUE. ! Presence du couple Rn222, Pb210
38!$OMP THREADPRIVATE(rnpb)
39
40
41CONTAINS
42
43  SUBROUTINE traclmdz_from_restart(trs_in)
44    ! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc).
45    ! This subroutine is called from phyetat0 after the field trs_in has been read.
46   
47    USE dimphy
48    USE infotrac
49    IMPLICIT NONE
50   
51    ! Input argument
52    REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in
53   
54    ! Local variables
55    INTEGER :: ierr
56   
57    ! Allocate restart variables trs
58    ALLOCATE( trs(klon,nbtr), stat=ierr)
59    IF (ierr /= 0) CALL abort_gcm('traclmdz_from_restart', 'pb in allocation 1',1)
60   
61    ! Initialize trs with values read from restart file
62    trs(:,:) = trs_in(:,:)
63   
64  END SUBROUTINE traclmdz_from_restart
65
66
67  SUBROUTINE traclmdz_init(pctsrf, ftsol, aerosol, lessivage)
68    ! This subroutine allocates and initialize module variables and control variables.
69    USE dimphy
70    USE infotrac
71
72    IMPLICIT NONE
73
74    INCLUDE "indicesol.h"
75
76! Input variables
77    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
78    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
79   
80! Output variables
81    LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
82    LOGICAL,INTENT(OUT)                  :: lessivage
83       
84! Local variables   
85    INTEGER :: ierr, it, iiq
86   
87! --------------------------------------------
88! Allocation
89! --------------------------------------------
90
91    ALLOCATE( scavtr(nbtr), stat=ierr)
92    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 9',1)
93    scavtr(:)=1.
94   
95    ALLOCATE( radio(nbtr), stat=ierr)
96    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 11',1)
97    radio(:) = .false.    ! Par defaut pas decroissance radioactive
98   
99    ALLOCATE( masktr(klon,nbtr), stat=ierr)
100    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 2',1)
101   
102    ALLOCATE( fshtr(klon,nbtr), stat=ierr)
103    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 3',1)
104   
105    ALLOCATE( hsoltr(nbtr), stat=ierr)
106    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 4',1)
107   
108    ALLOCATE( tautr(nbtr), stat=ierr)
109    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 5',1)
110    tautr(:)  = 0.
111   
112    ALLOCATE( vdeptr(nbtr), stat=ierr)
113    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 6',1)
114    vdeptr(:) = 0.
115
116
117    lessivage  = .TRUE.
118    aerosol(:) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
119   
120!
121! Recherche des traceurs connus : Be7, CO2,...
122! --------------------------------------------
123    id_be=0
124    DO it=1,nbtr
125       iiq=niadv(it+2)
126       IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR.  &
127            tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN 
128          ! Recherche du Beryllium 7
129          id_be=it
130          ALLOCATE( srcbe(klon,klev) )
131          radio(id_be) = .TRUE.
132          aerosol(id_be) = .TRUE. ! le Be est un aerosol
133          CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
134          WRITE(*,*) 'Initialisation srcBe: OK'
135       END IF   
136    END DO
137!
138! Valeurs specifiques pour les traceurs Rn222 et Pb210
139! ----------------------------------------------
140    IF (rnpb) THEN
141       
142       radio(1)= .TRUE.
143       radio(2)= .TRUE.
144       pbl_flg(1) = 0 ! au lieu de clsol=true ! CL au sol calcule
145       pbl_flg(2) = 0 ! au lieu de clsol=true
146       
147       aerosol(2) = .TRUE. ! le Pb est un aerosol
148       
149       CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
150    END IF
151
152  END SUBROUTINE traclmdz_init
153
154  SUBROUTINE traclmdz(                           &
155       nstep,    pdtphys,      t_seri,           &
156       paprs,    pplay,        cdragh,  coefh,   &
157       yu1,      yv1,          ftsol,   pctsrf,  &
158       xlat,     couchelimite,                   &
159       tr_seri,  source,       solsym,  d_tr_cl)
160   
161    USE dimphy
162    USE infotrac
163   
164    IMPLICIT NONE
165   
166    INCLUDE "YOMCST.h"
167    INCLUDE "indicesol.h"
168
169!==========================================================================
170!                   -- DESCRIPTION DES ARGUMENTS --
171!==========================================================================
172
173! Input arguments
174!
175!Configuration grille,temps:
176    INTEGER,INTENT(IN) :: nstep      ! nombre d'appels de la physiq
177    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde) 
178    REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point
179
180!
181!Physique:
182!--------
183    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
184    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
185    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
186
187
188!Couche limite:
189!--------------
190!
191    REAL,DIMENSION(klon,klev),INTENT(IN) :: cdragh     ! coeff drag pour T et Q
192    REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh      ! coeff melange CL (m**2/s)
193    REAL,DIMENSION(klon),INTENT(IN)      :: yu1        ! vents au premier niveau
194    REAL,DIMENSION(klon),INTENT(IN)      :: yv1        ! vents au premier niveau
195    LOGICAL,INTENT(IN)                   :: couchelimite
196
197! Arguments necessaires pour les sources et puits de traceur:
198    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
199    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
200
201! InOutput argument
202    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA] 
203
204! Output argument
205    CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
206    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit
207    REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT)   :: d_tr_cl ! Td couche limite/traceur
208
209
210!=======================================================================================
211!                        -- VARIABLES LOCALES TRACEURS --
212!=======================================================================================
213
214    INTEGER :: i, k, it
215
216    REAL,DIMENSION(klon)           :: d_trs    ! Td dans le reservoir
217    REAL,DIMENSION(klon,klev)      :: delp     ! epaisseur de couche (Pa)
218   
219    REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
220    REAL                           :: zrho      ! Masse Volumique de l'air KgA/m3
221
222!
223!
224!=================================================================
225!  Ajout de la production en  Be7 (Beryllium) srcbe U/s/kgA
226!=================================================================
227!
228    IF ( id_be /= 0 ) THEN
229       DO k = 1, klev
230          DO i = 1, klon
231             tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys
232          END DO
233       END DO
234       WRITE(*,*) 'Ajout srcBe dans tr_seri: OK'
235    END IF
236 
237
238    DO it=1,nbtr
239       WRITE(solsym(it),'(i2)') it
240    END DO
241!======================================================================
242!     -- Calcul de l'effet de la couche limite --
243!======================================================================
244
245    IF (couchelimite) THEN             
246       source(:,:) = 0.0
247
248       IF (id_be /=0) THEN
249          DO i=1, klon
250             zrho = pplay(i,1)/t_seri(i,1)/RD
251             source(i,id_be) = - vdeptr(id_be)*tr_seri(i,1,id_be)*zrho
252          END DO
253       END IF
254
255    END IF
256   
257
258    DO k = 1, klev
259       DO i = 1, klon
260          delp(i,k) = paprs(i,k)-paprs(i,k+1)
261       END DO
262    END DO
263   
264    DO it=1, nbtr
265       IF (couchelimite .AND. pbl_flg(it) == 0 ) THEN ! couche limite avec quantite dans le sol calculee
266          CALL cltracrn(it, pdtphys, yu1, yv1,     &
267               cdragh, coefh,t_seri,ftsol,pctsrf,  &
268               tr_seri(:,:,it),trs(:,it),          &
269               paprs, pplay, delp,                 &
270               masktr(:,it),fshtr(:,it),hsoltr(it),&
271               tautr(it),vdeptr(it),               &
272               xlat,d_tr_cl(:,:,it),d_trs)
273         
274          DO k = 1, klev
275             DO i = 1, klon
276                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
277             END DO
278          END DO
279       
280          ! Traceur dans le reservoir sol
281          DO i = 1, klon
282             trs(i,it) = trs(i,it) + d_trs(i)
283          END DO
284       END IF
285    END DO
286           
287!======================================================================
288!   Calcul de l'effet du puits radioactif
289!======================================================================
290    CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec)
291 
292    DO it=1,nbtr
293       IF(radio(it)) then     
294          DO k = 1, klev
295             DO i = 1, klon
296                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
297             END DO
298          END DO
299          CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it))
300       END IF
301    END DO
302
303  END SUBROUTINE traclmdz
304
305
306  SUBROUTINE traclmdz_to_restart(trs_out)
307    ! This subroutine is called from phyredem.F where the module
308    ! variable trs is written to restart file (restartphy.nc)
309    USE dimphy
310    USE infotrac
311   
312    IMPLICIT NONE
313   
314    REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
315    INTEGER :: ierr
316
317    IF ( ALLOCATED(trs) ) THEN
318       trs_out(:,:) = trs(:,:)
319    ELSE
320       ! No previous allocate of trs. This is the case for create_etat0_limit.
321       trs_out(:,:) = 0.0
322    END IF
323   
324  END SUBROUTINE traclmdz_to_restart
325 
326
327END MODULE traclmdz_mod
Note: See TracBrowser for help on using the repository browser.