source: LMDZ6/trunk/libf/dyn3d/qminimum.F @ 5213

Last change on this file since 5213 was 5199, checked in by dcugnet, 3 days ago

The "readTracFiles_mod" module usage is restricted to "infotrac" and" infotrac_phy" routines.
The internal routines or quantities of this module are now accessible through these these two routines:

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