1 |
|
|
! |
2 |
|
|
! $Header$ |
3 |
|
|
! |
4 |
|
2017 |
SUBROUTINE qminimum( q,nqtot,deltap ) |
5 |
|
|
|
6 |
|
|
USE infotrac, ONLY: niso, ntiso,iqIsoPha, tracers |
7 |
|
|
USE strings_mod, ONLY: strIdx |
8 |
|
|
USE readTracFiles_mod, ONLY: addPhase |
9 |
|
|
IMPLICIT none |
10 |
|
|
c |
11 |
|
|
c -- Objet : Traiter les valeurs trop petites (meme negatives) |
12 |
|
|
c pour l'eau vapeur et l'eau liquide |
13 |
|
|
c |
14 |
|
|
include "dimensions.h" |
15 |
|
|
include "paramet.h" |
16 |
|
|
c |
17 |
|
|
INTEGER nqtot |
18 |
|
|
REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm) |
19 |
|
|
c |
20 |
|
|
LOGICAL, SAVE :: first=.TRUE. |
21 |
|
|
INTEGER, SAVE :: iq_vap, iq_liq ! indices pour l'eau vapeur/liquide |
22 |
|
|
REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur |
23 |
|
|
REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide |
24 |
|
|
c |
25 |
|
|
c NB. ....( Il est souhaitable mais non obligatoire que les valeurs des |
26 |
|
|
c parametres seuil_vap, seuil_liq soient pareilles a celles |
27 |
|
|
c qui sont utilisees dans la routine ADDFI ) |
28 |
|
|
c ................................................................. |
29 |
|
|
c |
30 |
|
|
INTEGER i, k, iq |
31 |
|
|
REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe |
32 |
|
|
|
33 |
|
|
real zx_defau_diag(ip1jmp1,llm,2) |
34 |
|
|
real q_follow(ip1jmp1,llm,2) |
35 |
|
|
c |
36 |
|
|
REAL SSUM |
37 |
|
|
c |
38 |
|
|
INTEGER imprim |
39 |
|
|
SAVE imprim |
40 |
|
|
DATA imprim /0/ |
41 |
|
|
!INTEGER ijb,ije |
42 |
|
|
!INTEGER Index_pump(ij_end-ij_begin+1) |
43 |
|
|
!INTEGER nb_pump |
44 |
|
|
INTEGER ixt |
45 |
|
|
|
46 |
✓✓ |
2017 |
IF(first) THEN |
47 |
✓✗✓✓
|
6 |
iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) |
48 |
✓✗✓✓
|
6 |
iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) |
49 |
|
1 |
first = .FALSE. |
50 |
|
|
END IF |
51 |
|
|
c |
52 |
|
|
c Quand l'eau liquide est trop petite (ou negative), on prend |
53 |
|
|
c l'eau vapeur de la meme couche et la convertit en eau liquide |
54 |
|
|
c (sans changer la temperature !) |
55 |
|
|
c |
56 |
|
|
|
57 |
|
2017 |
call check_isotopes_seq(q,ip1jmp1,'qminimum 52') |
58 |
|
|
|
59 |
|
2017 |
zx_defau_diag(:,:,:)=0.0 |
60 |
✓✓✓✓
✓✓ |
171491391 |
q_follow(:,:,1:2)=q(:,:,1:2) |
61 |
✓✓ |
80680 |
DO 1000 k = 1, llm |
62 |
✓✓ |
85742670 |
DO 1040 i = 1, ip1jmp1 |
63 |
✓✓ |
85664007 |
if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then |
64 |
|
|
|
65 |
✗✓ |
14094201 |
if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1 |
66 |
|
|
: ( seuil_liq - q(i,k,iq_liq), 0.0 ) |
67 |
|
|
|
68 |
|
14094201 |
q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq |
69 |
|
14094201 |
q(i,k,iq_liq) = seuil_liq |
70 |
|
|
endif |
71 |
|
78663 |
1040 CONTINUE |
72 |
|
2017 |
1000 CONTINUE |
73 |
|
|
c |
74 |
|
|
c Quand l'eau vapeur est trop faible (ou negative), on complete |
75 |
|
|
c le defaut en prennant de l'eau vapeur de la couche au-dessous. |
76 |
|
|
c |
77 |
|
2017 |
iq = iq_vap |
78 |
|
|
c |
79 |
✓✓ |
78663 |
DO k = llm, 2, -1 |
80 |
|
|
ccc zx_abc = dpres(k) / dpres(k-1) |
81 |
✓✓ |
83546157 |
DO i = 1, ip1jmp1 |
82 |
✗✓ |
83544140 |
if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then |
83 |
|
|
|
84 |
|
|
if (niso > 0) |
85 |
|
|
& zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 ) |
86 |
|
|
|
87 |
|
|
q(i,k-1,iq) = q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) * |
88 |
|
|
& deltap(i,k) / deltap(i,k-1) |
89 |
|
|
q(i,k,iq) = seuil_vap |
90 |
|
|
endif |
91 |
|
|
ENDDO |
92 |
|
|
ENDDO |
93 |
|
|
c |
94 |
|
|
c Quand il s'agit de la premiere couche au-dessus du sol, on |
95 |
|
|
c doit imprimer un message d'avertissement (saturation possible). |
96 |
|
|
c |
97 |
✓✓ |
2198530 |
DO i = 1, ip1jmp1 |
98 |
|
2196513 |
zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) ) |
99 |
|
2198530 |
q(i,1,iq) = AMAX1( q(i,1,iq), seuil_vap ) |
100 |
|
|
ENDDO |
101 |
|
2017 |
pompe = SSUM(ip1jmp1,zx_pump,1) |
102 |
✓✗✗✓
|
2017 |
IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN |
103 |
|
|
WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe |
104 |
|
|
DO i = 1, ip1jmp1 |
105 |
|
|
IF (zx_pump(i).GT.0.0) THEN |
106 |
|
|
imprim = imprim + 1 |
107 |
|
|
PRINT*,'QMINIMUM: en ',i,zx_pump(i) |
108 |
|
|
ENDIF |
109 |
|
|
ENDDO |
110 |
|
|
ENDIF |
111 |
|
|
|
112 |
|
|
!write(*,*) 'qminimum 128' |
113 |
✗✓ |
2017 |
if (niso > 0) then |
114 |
|
|
! CRisi: traiter de même les traceurs d'eau |
115 |
|
|
! Mais il faut les prendre à l'envers pour essayer de conserver la |
116 |
|
|
! masse. |
117 |
|
|
! 1) pompage dans le sol |
118 |
|
|
! On suppose que ce pompage se fait sans isotopes -> on ne modifie |
119 |
|
|
! rien ici et on croise les doigts pour que ça ne soit pas trop |
120 |
|
|
! génant |
121 |
|
|
DO i = 1,ip1jmp1 |
122 |
|
|
if (zx_pump(i).gt.0.0) then |
123 |
|
|
q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i) |
124 |
|
|
endif !if (zx_pump(i).gt.0.0) then |
125 |
|
|
enddo !DO i = 1,ip1jmp1 |
126 |
|
|
|
127 |
|
|
! 2) transfert de vap vers les couches plus hautes |
128 |
|
|
!write(*,*) 'qminimum 139' |
129 |
|
|
do k=2,llm |
130 |
|
|
DO i = 1,ip1jmp1 |
131 |
|
|
if (zx_defau_diag(i,k,iq_vap).gt.0.0) then |
132 |
|
|
! on ajoute la vapeur en k |
133 |
|
|
do ixt=1,ntiso |
134 |
|
|
q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) |
135 |
|
|
: +zx_defau_diag(i,k,iq_vap) |
136 |
|
|
: *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap) |
137 |
|
|
|
138 |
|
|
! et on la retranche en k-1 |
139 |
|
|
q(i,k-1,iqIsoPha(ixt,iq_vap))= |
140 |
|
|
: q(i,k-1,iqIsoPha(ixt,iq_vap)) |
141 |
|
|
: -zx_defau_diag(i,k,iq_vap) |
142 |
|
|
: *deltap(i,k)/deltap(i,k-1) |
143 |
|
|
: *q(i,k-1,iqIsoPha(ixt,iq_vap)) |
144 |
|
|
: /q_follow(i,k-1,iq_vap) |
145 |
|
|
|
146 |
|
|
enddo !do ixt=1,niso |
147 |
|
|
q_follow(i,k,iq_vap)= q_follow(i,k,iq_vap) |
148 |
|
|
: +zx_defau_diag(i,k,iq_vap) |
149 |
|
|
q_follow(i,k-1,iq_vap)= q_follow(i,k-1,iq_vap) |
150 |
|
|
: -zx_defau_diag(i,k,iq_vap) |
151 |
|
|
: *deltap(i,k)/deltap(i,k-1) |
152 |
|
|
endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then |
153 |
|
|
enddo !DO i = 1, ip1jmp1 |
154 |
|
|
enddo !do k=2,llm |
155 |
|
|
|
156 |
|
|
call check_isotopes_seq(q,ip1jmp1,'qminimum 168') |
157 |
|
|
|
158 |
|
|
|
159 |
|
|
! 3) transfert d'eau de la vapeur au liquide |
160 |
|
|
!write(*,*) 'qminimum 164' |
161 |
|
|
do k=1,llm |
162 |
|
|
DO i = 1,ip1jmp1 |
163 |
|
|
if (zx_defau_diag(i,k,iq_liq).gt.0.0) then |
164 |
|
|
|
165 |
|
|
! on ajoute eau liquide en k en k |
166 |
|
|
do ixt=1,ntiso |
167 |
|
|
q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq)) |
168 |
|
|
: +zx_defau_diag(i,k,iq_liq) |
169 |
|
|
: *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap) |
170 |
|
|
! et on la retranche à la vapeur en k |
171 |
|
|
q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) |
172 |
|
|
: -zx_defau_diag(i,k,iq_liq) |
173 |
|
|
: *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap) |
174 |
|
|
enddo !do ixt=1,niso |
175 |
|
|
q_follow(i,k,iq_liq)= q_follow(i,k,iq_liq) |
176 |
|
|
: +zx_defau_diag(i,k,iq_liq) |
177 |
|
|
q_follow(i,k,iq_vap)= q_follow(i,k,iq_vap) |
178 |
|
|
: -zx_defau_diag(i,k,iq_liq) |
179 |
|
|
endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then |
180 |
|
|
enddo !DO i = 1, ip1jmp1 |
181 |
|
|
enddo !do k=2,llm |
182 |
|
|
|
183 |
|
|
call check_isotopes_seq(q,ip1jmp1,'qminimum 197') |
184 |
|
|
|
185 |
|
|
endif !if (niso > 0) then |
186 |
|
|
!write(*,*) 'qminimum 188' |
187 |
|
|
|
188 |
|
|
c |
189 |
|
2017 |
RETURN |
190 |
|
|
END |