source: LMDZ6/branches/DYNAMICO-conv-GC/libf/dyn3d/qminimum.F

Last change on this file was 2600, checked in by Ehouarn Millour, 8 years ago

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