source: LMDZ6/trunk/libf/phylmd/Dust/inscav_spl.f90 @ 5277

Last change on this file since 5277 was 5274, checked in by abarral, 9 hours ago

Replace yomcst.h by existing module
File size: 5.2 KB
Line 
1SUBROUTINE inscav_spl(pdtime,it,masse,henry,kk,qliq, &
2        flxr,flxs,zrho,zdz,t,x, &
3        his_dh)
4  USE dimphy
5  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
6USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
7          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
8          , R_ecc, R_peri, R_incl                                      &
9          , RA, RG, R1SA                                         &
10          , RSIGMA                                                     &
11          , R, RMD, RMV, RD, RV, RCPD                    &
12          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
13          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
14          , RCW, RCS                                                 &
15          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
16          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
17          , RALPD, RBETD, RGAMD
18IMPLICIT NONE
19  !=====================================================================
20  ! Objet : depot humide de traceurs
21  ! Date : mars 1998
22  ! Auteur: O. Boucher (LOA)
23  !=====================================================================
24  !
25
26  INCLUDE "chem.h"
27
28  INCLUDE "YOECUMF.h"
29  !
30  INTEGER :: it
31  REAL :: pdtime              ! pas de temps (s)
32  REAL :: masse               ! molar mass (except for BC/OM/IF/DUST=Nav)
33  REAL :: henry               ! constante de Henry en mol/l/atm
34  REAL :: kk                  ! coefficient de dependence en T (K)
35  REAL :: qliq                ! contenu en eau liquide dans le nuage (kg/kg)
36   ! REAL flxr(klon,klev+1)   ! flux precipitant de pluie
37   ! REAL flxs(klon,klev+1)   ! flux precipitant de neige
38  REAL :: flxr(klon,klev)   ! flux precipitant de pluie   ! Titane
39  REAL :: flxs(klon,klev)   ! flux precipitant de neige   ! Titane
40  REAL :: flxr_aux(klon,klev+1)
41  REAL :: flxs_aux(klon,klev+1)
42  REAL :: zrho(klon,klev)
43  REAL :: zdz(klon,klev)
44  REAL :: t(klon,klev)
45  REAL :: x(klon,klev)        ! q de traceur
46  REAL :: his_dh(klon)        ! tendance de traceur integre verticalement
47  !
48  !--variables locales
49  INTEGER :: i, k
50  !
51  REAL :: dx      ! tendance de traceur
52  REAL :: f_a     !--rapport de la phase aqueuse a la phase gazeuse
53  REAL :: beta    !--taux de conversion de l'eau en pluie
54  REAL :: henry_t !--constante de Henry a T t  (mol/l/atm)
55  REAL :: scav(klon,klev)    !--fraction aqueuse du constituant
56  REAL :: K1, K2, ph, frac
57  REAL :: frac_gas, frac_aer !-cste pour la reevaporation
58  PARAMETER (ph=5., frac_gas=1.0, frac_aer=0.5)
59  !---cste de dissolution pour le depot humide
60  REAL :: frac_fine_scav,frac_coar_scav
61  !---added by nhl
62  REAL :: aux_cte
63
64  PARAMETER (frac_fine_scav=0.7)
65  PARAMETER (frac_coar_scav=0.7)
66
67  !--101.325  m3/l x Pa/atm
68  !--R        Pa.m3/mol/K
69  !
70  !------------------------------------------
71  !
72  !nhl      IF (it.EQ.2.OR.it.EQ.3) THEN !--aerosol  ! AS IT WAS FIRST
73  IF (it.EQ.2.OR.it.EQ.3.OR.it.EQ.4) THEN !--aerosol
74    frac=frac_aer
75  ELSE                                                !--gas
76    frac=frac_gas
77  ENDIF
78  !
79  IF (it.EQ.1) THEN
80  DO k=1, klev
81  DO i=1, klon
82    henry_t=henry*exp(-kk*(1./298.-1./t(i,k)))    !--mol/l/atm
83    K1=1.2e-2*exp(-2010*(1/298.-1/t(i,k)))
84    K2=6.6e-8*exp(-1510*(1/298.-1/t(i,k)))
85    henry_t=henry_t*(1 + K1/10.**(-ph) + K1*K2/(10.**(-ph))**2)
86    f_a=henry_t/101.325*R*t(i,k)*qliq*zrho(i,k)/rho_water
87    scav(i,k)=f_a/(1.+f_a)
88  ENDDO
89  ENDDO
90  ELSEIF (it.EQ.2) THEN
91  DO k=1, klev
92  DO i=1, klon
93    scav(i,k)=frac_fine_scav
94  ENDDO
95  ENDDO
96  ELSEIF (it.EQ.3) THEN
97  DO k=1, klev
98  DO i=1, klon
99    scav(i,k)=frac_coar_scav
100  ENDDO
101  ENDDO
102  ELSEIF (it.EQ.4) THEN
103  DO k=1, klev
104  DO i=1, klon
105    scav(i,k)=frac_coar_scav
106  ENDDO
107  ENDDO
108  ELSE
109    PRINT *,'it non pris en compte'
110    STOP
111  ENDIF
112  !
113  ! NHL
114  ! Auxiliary variables defined to deal with the fact that precipitation
115  ! fluxes are defined on klev levels only.
116  ! NHL
117  !
118  flxr_aux(:,klev+1)=0.0
119  flxs_aux(:,klev+1)=0.0
120  flxr_aux(:,1:klev)=flxr(:,:)
121  flxs_aux(:,1:klev)=flxs(:,:)
122  DO k=klev, 1, -1
123  DO i=1, klon
124  !--scavenging
125    beta=flxr_aux(i,k)-flxr_aux(i,k+1)+flxs_aux(i,k)-flxs_aux(i,k+1)
126    beta=beta/zdz(i,k)/qliq/zrho(i,k)
127    beta=MAX(0.0,beta)
128    dx=x(i,k)*(exp(-scav(i,k)*beta*pdtime)-1.)
129    x(i,k)=x(i,k)+dx
130    his_dh(i)=his_dh(i)-dx/RNAVO* &
131          masse*1.e3*1.e6*zdz(i,k)/pdtime !--mgS/m2/s
132  !--reevaporation
133    beta=flxr_aux(i,k)-flxr_aux(i,k+1)+flxs_aux(i,k)-flxs_aux(i,k+1)
134    IF (beta.LT.0.) beta=beta/(flxr_aux(i,k+1)+flxs_aux(i,k+1))
135    IF (flxr_aux(i,k)+flxs_aux(i,k).EQ.0) THEN  !--reevaporation totale
136      beta=MIN(MAX(0.0,-beta),1.0)
137    ELSE                          !--reevaporation non totale pour aerosols
138      ! !print *,'FRAC USED IN INSCAV_SPL'
139      beta=MIN(MAX(0.0,-beta)*frac,1.0)
140    ENDIF
141    dx=beta*his_dh(i)*RNAVO/masse/1.e3/1.e6/zdz(i,k)*pdtime !ORIG LINE
142  ! funny line for TL/AD
143  ! AD test works without (x) and for xd = dxd*1.e5 : 2.79051851638 times the 0.
144  ! AD test does not work with the line : 754592404.083 times the 0.
145  ! problem seems to be linked to the largest dx wrt x
146    ! x(i, k) = x(i, k) + dx
147    !  x(i, k) = x(i, k) + dx         ! THIS LINE WAS COMMENTED OUT ORIGINALY !nhl
148    his_dh(i)=(1.-beta)*his_dh(i)
149  ENDDO
150  ENDDO
151  !
152  RETURN
153END SUBROUTINE inscav_spl
Note: See TracBrowser for help on using the repository browser.