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

Last change on this file since 1670 was 1670, checked in by idelkadi, 12 years ago

Modifications for inclusion of chimere dust emission module :
u* is passed from the boundary layer parameterization to the physics
main routine (physiq.F) and then to phytrac, traclmdz and change_srf_frac.
The interface of traclmdz is enriched with 4 other variables.
Also u* and the vertically cumulated amount of tracers is added in the
outputs.

Modifications pour l'inclusion du module d'émission de poussière de Chimere :
u* est passé depuis la couche limite vers le programme principal de la
physique (physiq.F) et ensuite à phytrac, traclmdz et change_srf_frac.
L'interface de traclmdz est enrichie avec 4 autres variables.
Les variables u* et les cumuls verticaux des traceurs sont ajoutés
dans les sorties.

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