source: LMDZ5/trunk/libf/phylmd/traclmdz_mod.F90 @ 1454

Last change on this file since 1454 was 1454, checked in by Laurent Fairhead, 14 years ago

Merge of LMDZ5V1.0-dev branch r1453 into LMDZ5 trunk r1434


Fusion entre la version r1453 de la branche de développement LMDZ5V1.0-dev
et le tronc LMDZ5 (r1434)

File size: 20.5 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  IMPLICIT NONE
9
10  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr   ! Masque reservoir de sol traceur
11!$OMP THREADPRIVATE(masktr)                        ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 )
12  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr    ! Flux surfacique dans le reservoir de sol
13!$OMP THREADPRIVATE(fshtr)
14  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: hsoltr   ! Epaisseur equivalente du reservoir de sol
15!$OMP THREADPRIVATE(hsoltr)
16!
17!Radioelements:
18!--------------
19!
20  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: tautr    ! Constante de decroissance radioactive
21!$OMP THREADPRIVATE(tautr)
22  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: vdeptr   ! Vitesse de depot sec dans la couche Brownienne
23!$OMP THREADPRIVATE(vdeptr)
24  REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: scavtr   ! Coefficient de lessivage
25!$OMP THREADPRIVATE(scavtr)
26  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe    ! Production du beryllium7 dans l atmosphere (U/s/kgA)
27!$OMP THREADPRIVATE(srcbe)
28
29  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio    ! radio(it)   = true  => decroisssance radioactive
30!$OMP THREADPRIVATE(radio) 
31
32  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs     ! Conc. radon ds le sol
33!$OMP THREADPRIVATE(trs)
34
35  INTEGER,SAVE :: id_aga      ! Identification number for tracer : Age of stratospheric air
36!$OMP THREADPRIVATE(id_aga)
37  INTEGER,SAVE :: lev_1p5km   ! Approximative vertical layer number at 1.5km above surface, used for calculation of the age of air. The result shouldn't be that sensible to the exactness of this value as long as it is in the lower troposphere.
38!$OMP THREADPRIVATE(lev_1p5km)
39
40  INTEGER,SAVE :: id_rn, id_pb ! Identification number for tracer : radon (Rn222), lead (Pb210)
41!$OMP THREADPRIVATE(id_rn, id_pb)
42
43  INTEGER,SAVE :: id_be       ! Activation et position du traceur Be7 [ id_be=0 -> desactive ]
44!$OMP THREADPRIVATE(id_be)
45
46  INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
47!$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq)
48  INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0   ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
49!                                              ! qui ne sont pas transportes par la convection
50!$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0)
51
52  INTEGER, SAVE:: id_o3
53!$OMP THREADPRIVATE(id_o3)
54! index of ozone tracer with Cariolle parameterization
55! 0 means no ozone tracer
56
57  LOGICAL,SAVE :: rnpb=.FALSE. ! Presence du couple Rn222, Pb210
58!$OMP THREADPRIVATE(rnpb)
59
60
61CONTAINS
62
63  SUBROUTINE traclmdz_from_restart(trs_in)
64    ! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc).
65    ! This subroutine is called from phyetat0 after the field trs_in has been read.
66   
67    USE dimphy
68    USE infotrac
69   
70    ! Input argument
71    REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in
72   
73    ! Local variables
74    INTEGER :: ierr
75   
76    ! Allocate restart variables trs
77    ALLOCATE( trs(klon,nbtr), stat=ierr)
78    IF (ierr /= 0) CALL abort_gcm('traclmdz_from_restart', 'pb in allocation 1',1)
79   
80    ! Initialize trs with values read from restart file
81    trs(:,:) = trs_in(:,:)
82   
83  END SUBROUTINE traclmdz_from_restart
84
85
86  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
87    ! This subroutine allocates and initialize module variables and control variables.
88    ! Initialization of the tracers should be done here only for those not found in the restart file.
89    USE dimphy
90    USE infotrac
91    USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
92    USE press_coefoz_m, ONLY: press_coefoz
93    USE carbon_cycle_mod, ONLY : carbon_cycle_init, carbon_cycle_tr, carbon_cycle_cpl
94    USE mod_grid_phy_lmdz
95    USE mod_phys_lmdz_para
96
97    INCLUDE "indicesol.h"
98    INCLUDE "iniprint.h"
99! Input variables
100    REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: pctsrf ! Pourcentage de sol f(nature du sol)
101    REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: ftsol  ! Temperature du sol (surf)(Kelvin)
102    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA] 
103    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
104    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
105    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
106    REAL,INTENT(IN)                        :: pdtphys ! Pas d'integration pour la physique (seconde) 
107
108! Output variables
109    LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
110    LOGICAL,INTENT(OUT)                  :: lessivage
111       
112! Local variables   
113    INTEGER :: ierr, it, iiq, i, k
114    REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global   
115    REAL, DIMENSION(klev)          :: mintmp, maxtmp
116    LOGICAL                        :: zero
117
118! --------------------------------------------
119! Allocation
120! --------------------------------------------
121    ALLOCATE( scavtr(nbtr), stat=ierr)
122    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 9',1)
123    scavtr(:)=1.
124   
125    ALLOCATE( radio(nbtr), stat=ierr)
126    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 11',1)
127    radio(:) = .false.    ! Par defaut pas decroissance radioactive
128   
129    ALLOCATE( masktr(klon,nbtr), stat=ierr)
130    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 2',1)
131   
132    ALLOCATE( fshtr(klon,nbtr), stat=ierr)
133    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 3',1)
134   
135    ALLOCATE( hsoltr(nbtr), stat=ierr)
136    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 4',1)
137   
138    ALLOCATE( tautr(nbtr), stat=ierr)
139    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 5',1)
140    tautr(:)  = 0.
141   
142    ALLOCATE( vdeptr(nbtr), stat=ierr)
143    IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 6',1)
144    vdeptr(:) = 0.
145
146
147    lessivage  = .TRUE.
148    aerosol(:) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
149   
150!
151! Recherche des traceurs connus : Be7, O3, CO2,...
152! --------------------------------------------
153    id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0
154    id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0
155    DO it=1,nbtr
156       iiq=niadv(it+2)
157       IF ( tname(iiq) == "RN" ) THEN
158          id_rn=it ! radon
159       ELSE IF ( tname(iiq) == "PB") THEN
160          id_pb=it ! plomb
161       ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN
162          ! Age of stratospheric air
163          id_aga=it
164          radio(id_aga) = .FALSE.
165          aerosol(id_aga) = .FALSE.
166          pbl_flg(id_aga) = 0
167         
168          ! Find the first model layer above 1.5km from the surface
169          IF (klev>=30) THEN
170             lev_1p5km=6   ! NB! This value is for klev=39
171          ELSE IF (klev>=10) THEN
172             lev_1p5km=5   ! NB! This value is for klev=19
173          ELSE
174             lev_1p5km=klev/2
175          END IF
176       ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR.  &
177            tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN 
178          ! Recherche du Beryllium 7
179          id_be=it
180          ALLOCATE( srcbe(klon,klev) )
181          radio(id_be) = .TRUE.
182          aerosol(id_be) = .TRUE. ! le Be est un aerosol
183          CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
184          WRITE(lunout,*) 'Initialisation srcBe: OK'
185       ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN
186          ! Recherche de l'ozone : parametrization de la chimie par Cariolle
187          id_o3=it
188          CALL alloc_coefoz   ! allocate ozone coefficients
189          CALL press_coefoz   ! read input pressure levels
190       ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN
191          id_pcsat=it
192       ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN
193          id_pcocsat=it
194       ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN
195          id_pcq=it
196       ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN
197          id_pcs0=it
198          conv_flg(it)=0 ! No transport by convection for this tracer
199       ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN
200          id_pcos0=it
201          conv_flg(it)=0 ! No transport by convection for this tracer
202       ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN
203          id_pcq0=it
204          conv_flg(it)=0 ! No transport by convection for this tracer
205       ELSE
206          WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq))
207       END IF
208    END DO
209
210!
211! Valeurs specifiques pour les traceurs Rn222 et Pb210
212! ----------------------------------------------
213    IF ( id_rn/=0 .AND. id_pb/=0 ) THEN
214       rnpb = .TRUE.
215       radio(id_rn)= .TRUE.
216       radio(id_pb)= .TRUE.
217       pbl_flg(id_rn) = 0 ! au lieu de clsol=true ! CL au sol calcule
218       pbl_flg(id_pb) = 0 ! au lieu de clsol=true
219       aerosol(id_rn) = .FALSE.
220       aerosol(id_pb) = .TRUE. ! le Pb est un aerosol
221       
222       CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
223    END IF
224
225!
226! Initialisation de module carbon_cycle_mod
227! ----------------------------------------------
228    IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
229       CALL carbon_cycle_init(tr_seri, pdtphys, aerosol, radio)
230    END IF
231
232! Check if all tracers have restart values
233! ----------------------------------------------
234    DO it=1,nbtr
235       iiq=niadv(it+2)
236       ! Test if tracer is zero everywhere.
237       ! Done by master process MPI and master thread OpenMP
238       CALL gather(tr_seri(:,:,it),varglo)
239       IF (is_mpi_root .AND. is_omp_root) THEN
240          mintmp=MINVAL(varglo,dim=1)
241          maxtmp=MAXVAL(varglo,dim=1)
242          IF (MINVAL(mintmp,dim=1)==0. .AND. MAXVAL(maxtmp,dim=1)==0.) THEN
243             ! Tracer is zero everywhere
244             zero=.TRUE.
245          ELSE
246             zero=.FALSE.
247          END IF
248       END IF
249
250       ! Distribute variable at all processes
251       CALL bcast(zero)
252
253       ! Initalize tracer that was not found in restart file.
254       IF (zero) THEN
255          ! The tracer was not found in restart file or it was equal zero everywhere.
256          WRITE(lunout,*) "The tracer ",trim(tname(iiq))," will be initialized"
257          IF (it==id_pcsat .OR. it==id_pcq .OR. &
258               it==id_pcs0 .OR. it==id_pcq0) THEN
259             tr_seri(:,:,it) = 100.
260          ELSE IF (it==id_pcocsat .OR. it==id_pcos0) THEN
261             DO i = 1, klon
262                IF ( pctsrf (i, is_oce) == 0. ) THEN
263                   tr_seri(i,:,it) = 0.
264                ELSE
265                   tr_seri(i,:,it) = 100.
266                END IF
267             END DO
268          ELSE
269             ! No specific initialization exist for this tracer
270             tr_seri(:,:,it) = 0.
271          END IF
272       END IF
273    END DO
274
275  END SUBROUTINE traclmdz_init
276
277  SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
278       cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
279       tr_seri, source, solsym, d_tr_cl, zmasse)
280   
281    USE dimphy
282    USE infotrac
283    USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
284    USE o3_chem_m, ONLY: o3_chem
285    USE carbon_cycle_mod, ONLY : carbon_cycle, carbon_cycle_tr, carbon_cycle_cpl
286    INCLUDE "YOMCST.h"
287    INCLUDE "indicesol.h"
288
289!==========================================================================
290!                   -- DESCRIPTION DES ARGUMENTS --
291!==========================================================================
292
293! Input arguments
294!
295!Configuration grille,temps:
296    INTEGER,INTENT(IN) :: nstep      ! nombre d'appels de la physiq
297    INTEGER,INTENT(IN) :: julien     ! Jour julien
298    REAL,INTENT(IN)    :: gmtime
299    REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde) 
300    REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point
301    REAL, INTENT(IN):: xlon(:) ! dim(klon) longitude
302
303!
304!Physique:
305!--------
306    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
307    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
308    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
309    REAL,intent(in):: zmasse (:, :)   ! dim(klon,klev) density of air, in kg/m2
310
311
312!Couche limite:
313!--------------
314!
315    REAL,DIMENSION(klon),INTENT(IN)      :: cdragh     ! coeff drag pour T et Q
316    REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh      ! coeff melange CL (m**2/s)
317    REAL,DIMENSION(klon),INTENT(IN)      :: yu1        ! vents au premier niveau
318    REAL,DIMENSION(klon),INTENT(IN)      :: yv1        ! vents au premier niveau
319    LOGICAL,INTENT(IN)                   :: couchelimite
320    REAL,DIMENSION(klon,klev),INTENT(IN) :: sh         ! humidite specifique
321
322! Arguments necessaires pour les sources et puits de traceur:
323    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
324    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
325
326! InOutput argument
327    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA] 
328
329! Output argument
330    CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
331    REAL,DIMENSION(klon,nbtr), INTENT(OUT)        :: source  ! a voir lorsque le flux de surface est prescrit
332    REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT)   :: d_tr_cl ! Td couche limite/traceur
333
334!=======================================================================================
335!                        -- VARIABLES LOCALES TRACEURS --
336!=======================================================================================
337
338    INTEGER :: i, k, it
339    INTEGER :: lmt_pas ! number of time steps of "physics" per day
340
341    REAL,DIMENSION(klon)           :: d_trs    ! Td dans le reservoir
342    REAL,DIMENSION(klon,klev)      :: qsat     ! pression de la vapeur a saturation
343    REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
344    REAL                           :: zrho     ! Masse Volumique de l'air KgA/m3
345    REAL                           :: amn, amx
346!
347!=================================================================
348!  Ajout de la production en  Be7 (Beryllium) srcbe U/s/kgA
349!=================================================================
350!
351    IF ( id_be /= 0 ) THEN
352       DO k = 1, klev
353          DO i = 1, klon
354             tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys
355          END DO
356       END DO
357       WRITE(*,*) 'Ajout srcBe dans tr_seri: OK'
358    END IF
359 
360
361!=================================================================
362! Update pseudo-vapor tracers
363!=================================================================
364
365    CALL q_sat(klon*klev,t_seri,pplay,qsat)
366
367    IF ( id_pcsat /= 0 ) THEN
368     DO k = 1, klev
369      DO i = 1, klon
370         IF ( pplay(i,k).GE.85000.) THEN
371            tr_seri(i,k,id_pcsat) = qsat(i,k)
372         ELSE
373            tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat))           
374         END IF
375      END DO
376     END DO
377    END IF
378
379    IF ( id_pcocsat /= 0 ) THEN
380     DO k = 1, klev
381      DO i = 1, klon
382         IF ( pplay(i,k).GE.85000.) THEN
383            IF ( pctsrf (i, is_oce) > 0. ) THEN
384               tr_seri(i,k,id_pcocsat) = qsat(i,k)
385            ELSE
386               tr_seri(i,k,id_pcocsat) = 0.
387          END IF
388       ELSE
389          tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat))
390       END IF
391      END DO
392     END DO
393    END IF
394
395    IF ( id_pcq /= 0 ) THEN
396     DO k = 1, klev
397      DO i = 1, klon
398         IF ( pplay(i,k).GE.85000.) THEN
399            tr_seri(i,k,id_pcq) = sh(i,k)
400         ELSE
401            tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq))   
402         END IF
403      END DO
404     END DO
405    END IF
406
407
408    IF ( id_pcs0 /= 0 ) THEN
409     DO k = 1, klev
410      DO i = 1, klon
411         IF ( pplay(i,k).GE.85000.) THEN
412            tr_seri(i,k,id_pcs0) = qsat(i,k)
413         ELSE
414            tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0))   
415         END IF
416      END DO
417     END DO
418    END IF
419
420
421    IF ( id_pcos0 /= 0 ) THEN
422     DO k = 1, klev
423      DO i = 1, klon
424         IF ( pplay(i,k).GE.85000.) THEN
425            IF ( pctsrf (i, is_oce) > 0. ) THEN
426               tr_seri(i,k,id_pcos0) = qsat(i,k)
427            ELSE
428               tr_seri(i,k,id_pcos0) = 0.
429            END IF
430         ELSE
431            tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0))
432         END IF
433      END DO
434     END DO
435    END IF
436
437
438    IF ( id_pcq0 /= 0 ) THEN
439     DO k = 1, klev
440      DO i = 1, klon
441         IF ( pplay(i,k).GE.85000.) THEN
442            tr_seri(i,k,id_pcq0) = sh(i,k)
443         ELSE
444            tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0))
445         END IF
446      END DO
447     END DO
448    END IF
449
450!=================================================================
451! Update tracer : Age of stratospheric air
452!=================================================================
453    IF (id_aga/=0) THEN
454       
455       ! Bottom layers
456       DO k = 1, lev_1p5km
457          tr_seri(:,k,id_aga) = 0.0
458       END DO
459       
460       ! Layers above 1.5km
461       DO k = lev_1p5km+1,klev-1
462          tr_seri(:,k,id_aga) = tr_seri(:,k,id_aga) + pdtphys
463       END DO
464       
465       ! Top layer
466       tr_seri(:,klev,id_aga) = tr_seri(:,klev-1,id_aga)
467       
468    END IF
469
470!======================================================================
471!     -- Calcul de l'effet de la couche limite --
472!======================================================================
473
474    IF (couchelimite) THEN             
475       source(:,:) = 0.0
476
477       IF (id_be /=0) THEN
478          DO i=1, klon
479             zrho = pplay(i,1)/t_seri(i,1)/RD
480             source(i,id_be) = - vdeptr(id_be)*tr_seri(i,1,id_be)*zrho
481          END DO
482       END IF
483
484    END IF
485   
486    DO it=1, nbtr
487       IF (couchelimite .AND. pbl_flg(it) == 0 .AND. (it==id_rn .OR. it==id_pb)) THEN
488          ! couche limite avec quantite dans le sol calculee
489          CALL cltracrn(it, pdtphys, yu1, yv1,     &
490               cdragh, coefh,t_seri,ftsol,pctsrf,  &
491               tr_seri(:,:,it),trs(:,it),          &
492               paprs, pplay, zmasse * rg, &
493               masktr(:,it),fshtr(:,it),hsoltr(it),&
494               tautr(it),vdeptr(it),               &
495               xlat,d_tr_cl(:,:,it),d_trs)
496         
497          DO k = 1, klev
498             DO i = 1, klon
499                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
500             END DO
501          END DO
502       
503          ! Traceur dans le reservoir sol
504          DO i = 1, klon
505             trs(i,it) = trs(i,it) + d_trs(i)
506          END DO
507       END IF
508    END DO
509         
510
511!======================================================================
512!   Calcul de l'effet du puits radioactif
513!======================================================================
514    CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec)
515
516    DO it=1,nbtr
517       WRITE(solsym(it),'(i2)') it
518    END DO
519
520    DO it=1,nbtr
521       IF(radio(it)) then     
522          DO k = 1, klev
523             DO i = 1, klon
524                tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
525             END DO
526          END DO
527          CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it))
528       END IF
529    END DO
530
531!======================================================================
532!   Parameterization of ozone chemistry
533!======================================================================
534
535    IF (id_o3 /= 0) then
536       lmt_pas = NINT(86400./pdtphys)
537       IF (MOD(nstep - 1, lmt_pas) == 0) THEN
538          ! Once per day, update the coefficients for ozone chemistry:
539          CALL regr_pr_comb_coefoz(julien, xlat, paprs, pplay)
540       END IF
541       CALL o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, xlat, &
542            xlon, tr_seri(:, :, id_o3))
543    END IF
544
545!======================================================================
546!   Calcul de cycle de carbon
547!======================================================================
548    IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
549       CALL carbon_cycle(nstep, pdtphys, pctsrf, tr_seri, source)
550    END IF
551
552  END SUBROUTINE traclmdz
553
554
555  SUBROUTINE traclmdz_to_restart(trs_out)
556    ! This subroutine is called from phyredem.F where the module
557    ! variable trs is written to restart file (restartphy.nc)
558    USE dimphy
559    USE infotrac
560   
561    REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
562    INTEGER :: ierr
563
564    IF ( ALLOCATED(trs) ) THEN
565       trs_out(:,:) = trs(:,:)
566    ELSE
567       ! No previous allocate of trs. This is the case for create_etat0_limit.
568       trs_out(:,:) = 0.0
569    END IF
570   
571  END SUBROUTINE traclmdz_to_restart
572 
573
574END MODULE traclmdz_mod
Note: See TracBrowser for help on using the repository browser.