Sources/phylmd/phytrac.f

module phytrac_m

  IMPLICIT none

  private
  public phytrac

contains

  SUBROUTINE phytrac(lmt_pas, julien, gmtime, firstcal, lafin, pdtphys, &
       t_seri, paprs, pplay, pmfu, pmfd, pde_u, pen_d, coefh, fm_therm, &
       entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, &
       mp, upwd, dnwd, tr_seri, zmasse, ncid_startphy)

    ! From phylmd/phytrac.F, version 1.15 2006/02/21 08:08:30 (SVN
    ! revision 679) and phylmd/write_histrac.h, version 1.9 2006/02/21
    ! 08:08:30

    ! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice
    ! Foujols, Olivia

    ! Objet : moniteur g\'en\'eral des tendances des traceurs

    ! L'appel de "phytrac" se fait avec "nqmx - 2" donc nous avons
    ! bien les vrais traceurs, sans la vapeur d'eau ni l'eau liquide.

    ! Modifications pour les traceurs :
    ! - uniformisation des parametrisations dans phytrac
    ! - stockage des moyennes des champs n\'ecessaires en mode traceur off-line 

    use abort_gcm_m, only: abort_gcm
    use clesphys, only: ecrit_tra
    use clesphys2, only: conv_emanuel
    use cltrac_m, only: cltrac
    use cltracrn_m, only: cltracrn
    use ctherm, only: iflag_thermals
    use cvltr_m, only: cvltr
    use dimens_m, only: llm, nqmx
    use dimphy, only: klon
    use histwrite_phy_m, only: histwrite_phy
    use indicesol, only: nbsrf
    use iniadvtrac_m, only: tname
    use initrrnpb_m, only: initrrnpb
    use minmaxqfi_m, only: minmaxqfi
    use netcdf, only: NF90_FILL_float
    use netcdf95, only: nf95_inq_varid, nf95_get_var, nf95_put_var
    use nflxtr_m, only: nflxtr
    use nr_util, only: assert
    use o3_chem_m, only: o3_chem
    use phyetat0_m, only: rlat
    use phyredem0_m, only: ncid_restartphy
    use press_coefoz_m, only: press_coefoz
    use radiornpb_m, only: radiornpb
    use regr_pr_comb_coefoz_m, only: regr_pr_comb_coefoz
    use SUPHEC_M, only: rg
    use time_phylmdz, only: itap

    integer, intent(in):: lmt_pas ! number of time steps of "physics" per day
    integer, intent(in):: julien !jour julien, 1 <= julien <= 360
    real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour
    logical, intent(in):: firstcal ! first call to "calfis"
    logical, intent(in):: lafin ! fin de la physique
    real, intent(in):: pdtphys ! pas d'integration pour la physique (s)
    real, intent(in):: t_seri(klon, llm) ! temperature, in K

    real, intent(in):: paprs(klon, llm+1)
    ! (pression pour chaque inter-couche, en Pa)

    real, intent(in):: pplay(klon, llm)
    ! (pression pour le mileu de chaque couche, en Pa)

    ! convection:

    REAL, intent(in):: pmfu(klon, llm) ! flux de masse dans le panache montant

    REAL, intent(in):: pmfd(klon, llm)
    ! flux de masse dans le panache descendant

    REAL pde_u(klon, llm) ! flux detraine dans le panache montant
    REAL pen_d(klon, llm) ! flux entraine dans le panache descendant
    REAL coefh(klon, llm) ! coeff melange couche limite

    ! thermiques:
    real fm_therm(klon, llm+1), entr_therm(klon, llm)

    ! Couche limite:
    REAL yu1(klon) ! vents au premier niveau
    REAL yv1(klon) ! vents au premier niveau

    ! Arguments n\'ecessaires pour les sources et puits de traceur :
    real, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)
    real pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)

    ! Lessivage pour le on-line
    REAL frac_impa(klon, llm) ! fraction d'aerosols impactes
    REAL frac_nucl(klon, llm) ! fraction d'aerosols nuclees

    ! Kerry Emanuel
    real, intent(in):: da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
    REAL, intent(in):: upwd(klon, llm) ! saturated updraft mass flux
    REAL, intent(in):: dnwd(klon, llm) ! saturated downdraft mass flux

    real, intent(inout):: tr_seri(:, :, :) ! (klon, llm, nqmx - 2)
    ! (mass fractions of tracers, excluding water, at mid-layers)

    real, intent(in):: zmasse(:, :) ! (klon, llm)
    ! (column-density of mass of air in a cell, in kg m-2)

    integer, intent(in):: ncid_startphy

    ! Local:

    integer nsplit

    ! TRACEURS

    ! Sources et puits des traceurs:

    ! Pour l'instant seuls les cas du rn et du pb ont ete envisages.

    REAL source(klon) ! a voir lorsque le flux est prescrit 
    ! 
    ! Pour la source de radon et son reservoir de sol

    REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol

    REAL masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur
    ! Masque de l'echange avec la surface
    ! (1 = reservoir) ou (possible => 1)
    SAVE masktr
    REAL fshtr(klon, nqmx - 2) ! Flux surfacique dans le reservoir de sol
    SAVE fshtr
    REAL hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol
    SAVE hsoltr
    REAL tautr(nqmx - 2) ! Constante de decroissance radioactive
    SAVE tautr
    REAL vdeptr(nqmx - 2) ! Vitesse de depot sec dans la couche Brownienne
    SAVE vdeptr
    REAL scavtr(nqmx - 2) ! Coefficient de lessivage
    SAVE scavtr

    CHARACTER itn

    ! nature du traceur

    logical aerosol(nqmx - 2) ! Nature du traceur
    ! ! aerosol(it) = true => aerosol 
    ! ! aerosol(it) = false => gaz 
    logical clsol(nqmx - 2) ! couche limite sol calcul\'ee
    logical radio(nqmx - 2) ! d\'ecroisssance radioactive
    save aerosol, clsol, radio

    ! convection tiedtke
    INTEGER i, k, it
    REAL delp(klon, llm)

    ! Variables liees a l'ecriture de la bande histoire physique

    ! Variables locales pour effectuer les appels en serie

    REAL d_tr(klon, llm), d_trs(klon) ! tendances de traceurs 
    REAL d_tr_cl(klon, llm, nqmx - 2) ! tendance de traceurs couche limite

    REAL d_tr_cv(klon, llm, nqmx - 2) 
    ! tendance de traceurs conv pour chq traceur

    REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques
    REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance 
    ! ! radioactive du rn - > pb 
    REAL d_tr_lessi_impa(klon, llm, nqmx - 2) ! la tendance du lessivage 
    ! ! par impaction
    REAL d_tr_lessi_nucl(klon, llm, nqmx - 2) ! la tendance du lessivage 
    ! ! par nucleation 
    REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage 
    ! ! dans chaque couche 

    real ztra_th(klon, llm)
    integer isplit, varid

    ! Controls:
    logical:: couchelimite = .true.
    logical:: convection = .true.
    logical:: lessivage = .true.
    logical, save:: inirnpb

    !--------------------------------------

    call assert(shape(zmasse) == (/klon, llm/), "phytrac zmasse")
    call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")

    if (firstcal) then
       print *, 'phytrac: pdtphys = ', pdtphys
       PRINT *, 'Frequency of tracer output: ecrit_tra = ', ecrit_tra
       inirnpb = .true.

       ! Initialisation de certaines variables pour le radon et le plomb 
       ! Initialisation du traceur dans le sol (couche limite radonique)
       trs(:, 2:) = 0.

       call nf95_inq_varid(ncid_startphy, "trs", varid)
       call nf95_get_var(ncid_startphy, varid, trs(:, 1))
       if (any(trs(:, 1) == NF90_FILL_float)) call abort_gcm("phytrac", &
            "some missing values in trs(:, 1)")

       ! Initialisation de la fraction d'aerosols lessivee

       d_tr_lessi_impa = 0.
       d_tr_lessi_nucl = 0. 

       ! Initialisation de la nature des traceurs

       DO it = 1, nqmx - 2
          aerosol(it) = .FALSE. ! Tous les traceurs sont des gaz par defaut
          radio(it) = .FALSE. ! par d\'efaut pas de passage par "radiornpb"
          clsol(it) = .FALSE. ! Par defaut couche limite avec flux prescrit
       ENDDO

       if (nqmx >= 5) then
          call press_coefoz ! read input pressure levels for ozone coefficients
       end if
    ENDIF

    if (inirnpb) THEN
       ! Initialisation du traceur dans le sol (couche limite radonique)
       radio(1)= .true.
       radio(2)= .true.
       clsol(1)= .true.
       clsol(2)= .true.
       aerosol(2) = .TRUE. ! le Pb est un aerosol 
       call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)
       inirnpb=.false.
    endif

    if (convection) then
       ! Calcul de l'effet de la convection
       DO it=1, nqmx - 2
          if (conv_emanuel) then
             call cvltr(pdtphys, da, phi, mp, paprs, tr_seri(:, :, it), upwd, &
                  dnwd, d_tr_cv(:, :, it))
          else
             CALL nflxtr(pdtphys, pmfu, pmfd, pde_u, pen_d, paprs, &
                  tr_seri(:, :, it), d_tr_cv(:, :, it))
          endif

          DO k = 1, llm
             DO i = 1, klon
                tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cv(i, k, it)
             ENDDO
          ENDDO
          WRITE(unit=itn, fmt='(i1)') it
          CALL minmaxqfi(tr_seri(:, :, it), 0., 1e33, &
               'convection, tracer index = ' // itn)
       ENDDO
    endif

    ! Calcul de l'effet des thermiques

    do it=1, nqmx - 2
       do k=1, llm
          do i=1, klon
             d_tr_th(i, k, it)=0.
             tr_seri(i, k, it)=max(tr_seri(i, k, it), 0.)
             tr_seri(i, k, it)=min(tr_seri(i, k, it), 1e10)
          enddo
       enddo
    enddo

    if (iflag_thermals > 0) then
       nsplit=10
       DO it=1, nqmx - 2
          do isplit=1, nsplit
             ! Thermiques 
             call dqthermcell(klon, llm, pdtphys/nsplit &
                  , fm_therm, entr_therm, zmasse &
                  , tr_seri(1:klon, 1:llm, it), d_tr, ztra_th)

             do k=1, llm
                do i=1, klon
                   d_tr(i, k)=pdtphys*d_tr(i, k)/nsplit
                   d_tr_th(i, k, it)=d_tr_th(i, k, it)+d_tr(i, k)
                   tr_seri(i, k, it)=max(tr_seri(i, k, it)+d_tr(i, k), 0.)
                enddo
             enddo
          enddo
       ENDDO
    endif

    ! Calcul de l'effet de la couche limite

    if (couchelimite) then
       DO k = 1, llm
          DO i = 1, klon
             delp(i, k) = paprs(i, k)-paprs(i, k+1)
          ENDDO
       ENDDO

       ! MAF modif pour tenir compte du cas traceur
       DO it=1, nqmx - 2
          if (clsol(it)) then 
             ! couche limite avec quantite dans le sol calculee
             CALL cltracrn(it, pdtphys, yu1, yv1, coefh, t_seri, ftsol, &
                  pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &
                  masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &
                  vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)
             DO k = 1, llm
                DO i = 1, klon
                   tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
                ENDDO
             ENDDO

             trs(:, it) = trs(:, it) + d_trs
          else
             ! couche limite avec flux prescrit
             !MAF provisoire source / traceur a creer
             DO i=1, klon
                source(i) = 0. ! pas de source, pour l'instant
             ENDDO

             CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &
                  paprs, pplay, delp, d_tr_cl(1, 1, it))
             DO k = 1, llm
                DO i = 1, klon
                   tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
                ENDDO
             ENDDO
          endif
       ENDDO
    endif

    ! Calcul de l'effet du puits radioactif

    ! MAF il faudrait faire une modification pour passer dans radiornpb 
    ! si radio=true
    d_tr_dec = radiornpb(tr_seri, pdtphys, tautr)
    DO it = 1, nqmx - 2
       if (radio(it)) then
          tr_seri(:, :, it) = tr_seri(:, :, it) + d_tr_dec(:, :, it)
          WRITE(unit=itn, fmt='(i1)') it
          CALL minmaxqfi(tr_seri(:, :, it), 0., 1e33, 'puits rn it='//itn)
       endif
    ENDDO

    if (nqmx >= 5) then
       ! Ozone as a tracer:
       if (mod(itap - 1, lmt_pas) == 0) then
          ! Once per day, update the coefficients for ozone chemistry:
          call regr_pr_comb_coefoz(julien, paprs, pplay)
       end if
       call o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, tr_seri(:, :, 3))
    end if

    ! Calcul de l'effet de la precipitation

    IF (lessivage) THEN
       d_tr_lessi_nucl = 0. 
       d_tr_lessi_impa = 0. 
       flestottr = 0. 

       ! tendance des aerosols nuclees et impactes 

       DO it = 1, nqmx - 2
          IF (aerosol(it)) THEN
             DO k = 1, llm
                DO i = 1, klon
                   d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &
                        (1 - frac_nucl(i, k))*tr_seri(i, k, it)
                   d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &
                        (1 - frac_impa(i, k))*tr_seri(i, k, it)
                ENDDO
             ENDDO
          ENDIF
       ENDDO

       ! Mises a jour des traceurs + calcul des flux de lessivage 
       ! Mise a jour due a l'impaction et a la nucleation

       DO it = 1, nqmx - 2
          IF (aerosol(it)) THEN
             DO k = 1, llm
                DO i = 1, klon
                   tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &
                        * frac_nucl(i, k)
                ENDDO
             ENDDO
          ENDIF
       ENDDO

       ! Flux lessivage total 

       DO it = 1, nqmx - 2
          DO k = 1, llm
             DO i = 1, klon
                flestottr(i, k, it) = flestottr(i, k, it) &
                     - (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &
                     * (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)
             ENDDO
          ENDDO
       ENDDO
    ENDIF

    ! Ecriture des sorties
    CALL histwrite_phy("zmasse", zmasse)
    DO it=1, nqmx - 2
       CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
       if (lessivage) THEN
          CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
       endif
       CALL histwrite_phy("d_tr_th_"//tname(it+2), d_tr_th(:, :, it))
       CALL histwrite_phy("d_tr_cv_"//tname(it+2), d_tr_cv(:, :, it))
       CALL histwrite_phy("d_tr_cl_"//tname(it+2), d_tr_cl(:, :, it))
    ENDDO

    if (lafin) then
       call nf95_inq_varid(ncid_restartphy, "trs", varid)
       call nf95_put_var(ncid_restartphy, varid, trs(:, 1))
    endif

  END SUBROUTINE phytrac

end module phytrac_m
1	module phytrac_m
2
3	IMPLICIT none
4
5	private
6	public phytrac
7
8	contains
9
10	SUBROUTINE phytrac(lmt_pas, julien, gmtime, firstcal, lafin, pdtphys, &
11	t_seri, paprs, pplay, pmfu, pmfd, pde_u, pen_d, coefh, fm_therm, &
12	entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, &
13	mp, upwd, dnwd, tr_seri, zmasse, ncid_startphy)
14
15	! From phylmd/phytrac.F, version 1.15 2006/02/21 08:08:30 (SVN
16	! revision 679) and phylmd/write_histrac.h, version 1.9 2006/02/21
17	! 08:08:30
18
19	! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice
20	! Foujols, Olivia
21
22	! Objet : moniteur g\'en\'eral des tendances des traceurs
23
24	! L'appel de "phytrac" se fait avec "nqmx - 2" donc nous avons
25	! bien les vrais traceurs, sans la vapeur d'eau ni l'eau liquide.
26
27	! Modifications pour les traceurs :
28	! - uniformisation des parametrisations dans phytrac
29	! - stockage des moyennes des champs n\'ecessaires en mode traceur off-line
30
31	use abort_gcm_m, only: abort_gcm
32	use clesphys, only: ecrit_tra
33	use clesphys2, only: conv_emanuel
34	use cltrac_m, only: cltrac
35	use cltracrn_m, only: cltracrn
36	use ctherm, only: iflag_thermals
37	use cvltr_m, only: cvltr
38	use dimens_m, only: llm, nqmx
39	use dimphy, only: klon
40	use histwrite_phy_m, only: histwrite_phy
41	use indicesol, only: nbsrf
42	use iniadvtrac_m, only: tname
43	use initrrnpb_m, only: initrrnpb
44	use minmaxqfi_m, only: minmaxqfi
45	use netcdf, only: NF90_FILL_float
46	use netcdf95, only: nf95_inq_varid, nf95_get_var, nf95_put_var
47	use nflxtr_m, only: nflxtr
48	use nr_util, only: assert
49	use o3_chem_m, only: o3_chem
50	use phyetat0_m, only: rlat
51	use phyredem0_m, only: ncid_restartphy
52	use press_coefoz_m, only: press_coefoz
53	use radiornpb_m, only: radiornpb
54	use regr_pr_comb_coefoz_m, only: regr_pr_comb_coefoz
55	use SUPHEC_M, only: rg
56	use time_phylmdz, only: itap
57
58	integer, intent(in):: lmt_pas ! number of time steps of "physics" per day
59	integer, intent(in):: julien !jour julien, 1 <= julien <= 360
60	real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour
61	logical, intent(in):: firstcal ! first call to "calfis"
62	logical, intent(in):: lafin ! fin de la physique
63	real, intent(in):: pdtphys ! pas d'integration pour la physique (s)
64	real, intent(in):: t_seri(klon, llm) ! temperature, in K
65
66	real, intent(in):: paprs(klon, llm+1)
67	! (pression pour chaque inter-couche, en Pa)
68
69	real, intent(in):: pplay(klon, llm)
70	! (pression pour le mileu de chaque couche, en Pa)
71
72	! convection:
73
74	REAL, intent(in):: pmfu(klon, llm) ! flux de masse dans le panache montant
75
76	REAL, intent(in):: pmfd(klon, llm)
77	! flux de masse dans le panache descendant
78
79	REAL pde_u(klon, llm) ! flux detraine dans le panache montant
80	REAL pen_d(klon, llm) ! flux entraine dans le panache descendant
81	REAL coefh(klon, llm) ! coeff melange couche limite
82
83	! thermiques:
84	real fm_therm(klon, llm+1), entr_therm(klon, llm)
85
86	! Couche limite:
87	REAL yu1(klon) ! vents au premier niveau
88	REAL yv1(klon) ! vents au premier niveau
89
90	! Arguments n\'ecessaires pour les sources et puits de traceur :
91	real, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)
92	real pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)
93
94	! Lessivage pour le on-line
95	REAL frac_impa(klon, llm) ! fraction d'aerosols impactes
96	REAL frac_nucl(klon, llm) ! fraction d'aerosols nuclees
97
98	! Kerry Emanuel
99	real, intent(in):: da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
100	REAL, intent(in):: upwd(klon, llm) ! saturated updraft mass flux
101	REAL, intent(in):: dnwd(klon, llm) ! saturated downdraft mass flux
102
103	real, intent(inout):: tr_seri(:, :, :) ! (klon, llm, nqmx - 2)
104	! (mass fractions of tracers, excluding water, at mid-layers)
105
106	real, intent(in):: zmasse(:, :) ! (klon, llm)
107	! (column-density of mass of air in a cell, in kg m-2)
108
109	integer, intent(in):: ncid_startphy
110
111	! Local:
112
113	integer nsplit
114
115	! TRACEURS
116
117	! Sources et puits des traceurs:
118
119	! Pour l'instant seuls les cas du rn et du pb ont ete envisages.
120
121	REAL source(klon) ! a voir lorsque le flux est prescrit
122	!
123	! Pour la source de radon et son reservoir de sol
124
125	REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol
126
127	REAL masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur
128	! Masque de l'echange avec la surface
129	! (1 = reservoir) ou (possible => 1)
130	SAVE masktr
131	REAL fshtr(klon, nqmx - 2) ! Flux surfacique dans le reservoir de sol
132	SAVE fshtr
133	REAL hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol
134	SAVE hsoltr
135	REAL tautr(nqmx - 2) ! Constante de decroissance radioactive
136	SAVE tautr
137	REAL vdeptr(nqmx - 2) ! Vitesse de depot sec dans la couche Brownienne
138	SAVE vdeptr
139	REAL scavtr(nqmx - 2) ! Coefficient de lessivage
140	SAVE scavtr
141
142	CHARACTER itn
143
144	! nature du traceur
145
146	logical aerosol(nqmx - 2) ! Nature du traceur
147	! ! aerosol(it) = true => aerosol
148	! ! aerosol(it) = false => gaz
149	logical clsol(nqmx - 2) ! couche limite sol calcul\'ee
150	logical radio(nqmx - 2) ! d\'ecroisssance radioactive
151	save aerosol, clsol, radio
152
153	! convection tiedtke
154	INTEGER i, k, it
155	REAL delp(klon, llm)
156
157	! Variables liees a l'ecriture de la bande histoire physique
158
159	! Variables locales pour effectuer les appels en serie
160
161	REAL d_tr(klon, llm), d_trs(klon) ! tendances de traceurs
162	REAL d_tr_cl(klon, llm, nqmx - 2) ! tendance de traceurs couche limite
163
164	REAL d_tr_cv(klon, llm, nqmx - 2)
165	! tendance de traceurs conv pour chq traceur
166
167	REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques
168	REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance
169	! ! radioactive du rn - > pb
170	REAL d_tr_lessi_impa(klon, llm, nqmx - 2) ! la tendance du lessivage
171	! ! par impaction
172	REAL d_tr_lessi_nucl(klon, llm, nqmx - 2) ! la tendance du lessivage
173	! ! par nucleation
174	REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage
175	! ! dans chaque couche
176
177	real ztra_th(klon, llm)
178	integer isplit, varid
179
180	! Controls:
181	logical:: couchelimite = .true.
182	logical:: convection = .true.
183	logical:: lessivage = .true.
184	logical, save:: inirnpb
185
186	!--------------------------------------
187
188	call assert(shape(zmasse) == (/klon, llm/), "phytrac zmasse")
189	call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")
190
191	if (firstcal) then
192	print *, 'phytrac: pdtphys = ', pdtphys
193	PRINT *, 'Frequency of tracer output: ecrit_tra = ', ecrit_tra
194	inirnpb = .true.
195
196	! Initialisation de certaines variables pour le radon et le plomb
197	! Initialisation du traceur dans le sol (couche limite radonique)
198	trs(:, 2:) = 0.
199
200	call nf95_inq_varid(ncid_startphy, "trs", varid)
201	call nf95_get_var(ncid_startphy, varid, trs(:, 1))
202	if (any(trs(:, 1) == NF90_FILL_float)) call abort_gcm("phytrac", &
203	"some missing values in trs(:, 1)")
204
205	! Initialisation de la fraction d'aerosols lessivee
206
207	d_tr_lessi_impa = 0.
208	d_tr_lessi_nucl = 0.
209
210	! Initialisation de la nature des traceurs
211
212	DO it = 1, nqmx - 2
213	aerosol(it) = .FALSE. ! Tous les traceurs sont des gaz par defaut
214	radio(it) = .FALSE. ! par d\'efaut pas de passage par "radiornpb"
215	clsol(it) = .FALSE. ! Par defaut couche limite avec flux prescrit
216	ENDDO
217
218	if (nqmx >= 5) then
219	call press_coefoz ! read input pressure levels for ozone coefficients
220	end if
221	ENDIF
222
223	if (inirnpb) THEN
224	! Initialisation du traceur dans le sol (couche limite radonique)
225	radio(1)= .true.
226	radio(2)= .true.
227	clsol(1)= .true.
228	clsol(2)= .true.
229	aerosol(2) = .TRUE. ! le Pb est un aerosol
230	call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)
231	inirnpb=.false.
232	endif
233
234	if (convection) then
235	! Calcul de l'effet de la convection
236	DO it=1, nqmx - 2
237	if (conv_emanuel) then
238	call cvltr(pdtphys, da, phi, mp, paprs, tr_seri(:, :, it), upwd, &
239	dnwd, d_tr_cv(:, :, it))
240	else
241	CALL nflxtr(pdtphys, pmfu, pmfd, pde_u, pen_d, paprs, &
242	tr_seri(:, :, it), d_tr_cv(:, :, it))
243	endif
244
245	DO k = 1, llm
246	DO i = 1, klon
247	tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cv(i, k, it)
248	ENDDO
249	ENDDO
250	WRITE(unit=itn, fmt='(i1)') it
251	CALL minmaxqfi(tr_seri(:, :, it), 0., 1e33, &
252	'convection, tracer index = ' // itn)
253	ENDDO
254	endif
255
256	! Calcul de l'effet des thermiques
257
258	do it=1, nqmx - 2
259	do k=1, llm
260	do i=1, klon
261	d_tr_th(i, k, it)=0.
262	tr_seri(i, k, it)=max(tr_seri(i, k, it), 0.)
263	tr_seri(i, k, it)=min(tr_seri(i, k, it), 1e10)
264	enddo
265	enddo
266	enddo
267
268	if (iflag_thermals > 0) then
269	nsplit=10
270	DO it=1, nqmx - 2
271	do isplit=1, nsplit
272	! Thermiques
273	call dqthermcell(klon, llm, pdtphys/nsplit &
274	, fm_therm, entr_therm, zmasse &
275	, tr_seri(1:klon, 1:llm, it), d_tr, ztra_th)
276
277	do k=1, llm
278	do i=1, klon
279	d_tr(i, k)=pdtphys*d_tr(i, k)/nsplit
280	d_tr_th(i, k, it)=d_tr_th(i, k, it)+d_tr(i, k)
281	tr_seri(i, k, it)=max(tr_seri(i, k, it)+d_tr(i, k), 0.)
282	enddo
283	enddo
284	enddo
285	ENDDO
286	endif
287
288	! Calcul de l'effet de la couche limite
289
290	if (couchelimite) then
291	DO k = 1, llm
292	DO i = 1, klon
293	delp(i, k) = paprs(i, k)-paprs(i, k+1)
294	ENDDO
295	ENDDO
296
297	! MAF modif pour tenir compte du cas traceur
298	DO it=1, nqmx - 2
299	if (clsol(it)) then
300	! couche limite avec quantite dans le sol calculee
301	CALL cltracrn(it, pdtphys, yu1, yv1, coefh, t_seri, ftsol, &
302	pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &
303	masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &
304	vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)
305	DO k = 1, llm
306	DO i = 1, klon
307	tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
308	ENDDO
309	ENDDO
310
311	trs(:, it) = trs(:, it) + d_trs
312	else
313	! couche limite avec flux prescrit
314	!MAF provisoire source / traceur a creer
315	DO i=1, klon
316	source(i) = 0. ! pas de source, pour l'instant
317	ENDDO
318
319	CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &
320	paprs, pplay, delp, d_tr_cl(1, 1, it))
321	DO k = 1, llm
322	DO i = 1, klon
323	tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
324	ENDDO
325	ENDDO
326	endif
327	ENDDO
328	endif
329
330	! Calcul de l'effet du puits radioactif
331
332	! MAF il faudrait faire une modification pour passer dans radiornpb
333	! si radio=true
334	d_tr_dec = radiornpb(tr_seri, pdtphys, tautr)
335	DO it = 1, nqmx - 2
336	if (radio(it)) then
337	tr_seri(:, :, it) = tr_seri(:, :, it) + d_tr_dec(:, :, it)
338	WRITE(unit=itn, fmt='(i1)') it
339	CALL minmaxqfi(tr_seri(:, :, it), 0., 1e33, 'puits rn it='//itn)
340	endif
341	ENDDO
342
343	if (nqmx >= 5) then
344	! Ozone as a tracer:
345	if (mod(itap - 1, lmt_pas) == 0) then
346	! Once per day, update the coefficients for ozone chemistry:
347	call regr_pr_comb_coefoz(julien, paprs, pplay)
348	end if
349	call o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, tr_seri(:, :, 3))
350	end if
351
352	! Calcul de l'effet de la precipitation
353
354	IF (lessivage) THEN
355	d_tr_lessi_nucl = 0.
356	d_tr_lessi_impa = 0.
357	flestottr = 0.
358
359	! tendance des aerosols nuclees et impactes
360
361	DO it = 1, nqmx - 2
362	IF (aerosol(it)) THEN
363	DO k = 1, llm
364	DO i = 1, klon
365	d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &
366	(1 - frac_nucl(i, k))*tr_seri(i, k, it)
367	d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &
368	(1 - frac_impa(i, k))*tr_seri(i, k, it)
369	ENDDO
370	ENDDO
371	ENDIF
372	ENDDO
373
374	! Mises a jour des traceurs + calcul des flux de lessivage
375	! Mise a jour due a l'impaction et a la nucleation
376
377	DO it = 1, nqmx - 2
378	IF (aerosol(it)) THEN
379	DO k = 1, llm
380	DO i = 1, klon
381	tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &
382	* frac_nucl(i, k)
383	ENDDO
384	ENDDO
385	ENDIF
386	ENDDO
387
388	! Flux lessivage total
389
390	DO it = 1, nqmx - 2
391	DO k = 1, llm
392	DO i = 1, klon
393	flestottr(i, k, it) = flestottr(i, k, it) &
394	- (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &
395	* (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)
396	ENDDO
397	ENDDO
398	ENDDO
399	ENDIF
400
401	! Ecriture des sorties
402	CALL histwrite_phy("zmasse", zmasse)
403	DO it=1, nqmx - 2
404	CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
405	if (lessivage) THEN
406	CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
407	endif
408	CALL histwrite_phy("d_tr_th_"//tname(it+2), d_tr_th(:, :, it))
409	CALL histwrite_phy("d_tr_cv_"//tname(it+2), d_tr_cv(:, :, it))
410	CALL histwrite_phy("d_tr_cl_"//tname(it+2), d_tr_cl(:, :, it))
411	ENDDO
412
413	if (lafin) then
414	call nf95_inq_varid(ncid_restartphy, "trs", varid)
415	call nf95_put_var(ncid_restartphy, varid, trs(:, 1))
416	endif
417
418	END SUBROUTINE phytrac
419
420	end module phytrac_m