source: LMDZ5/branches/AI-cosp/libf/dyn3d/qminimum.F @ 4471

Last change on this file since 4471 was 2286, checked in by Ehouarn Millour, 9 years ago
  • fix in dyn3d the array out of bound issue (in qminimum) that was only corrected in dyn3dmem in rev 2285.
  • comment out many invasive debug writes.

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"
14#include "comvert.h"
15c
16      INTEGER nqtot
17      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
18c
19      INTEGER iq_vap, iq_liq
20      PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
21      PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
22      REAL seuil_vap, seuil_liq
23      PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
24      PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
25c
26c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
27c            parametres seuil_vap, seuil_liq soient pareilles a celles
28c            qui  sont utilisees dans la routine    ADDFI       )
29c     .................................................................
30c
31      INTEGER i, k, iq
32      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
33
34      real zx_defau_diag(ip1jmp1,llm,2)
35      real q_follow(ip1jmp1,llm,2)
36c
37      REAL SSUM
38c
39      INTEGER imprim
40      SAVE imprim
41      DATA imprim /0/
42      !INTEGER ijb,ije
43      !INTEGER Index_pump(ij_end-ij_begin+1)
44      !INTEGER nb_pump
45      INTEGER ixt
46c
47c Quand l'eau liquide est trop petite (ou negative), on prend
48c l'eau vapeur de la meme couche et la convertit en eau liquide
49c (sans changer la temperature !)
50c
51
52        if (ok_iso_verif) then
53           call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
54        endif !if (ok_iso_verif) then     
55
56      zx_defau_diag(:,:,:)=0.0
57      q_follow(:,:,1:2)=q(:,:,1:2) 
58      DO 1000 k = 1, llm
59        DO 1040 i = 1, ip1jmp1
60          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
61
62              if (ok_isotopes) then
63                 zx_defau_diag(i,k,iq_liq)=AMAX1
64     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
65              endif !if (ok_isotopes) then
66
67             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
68             q(i,k,iq_liq) = seuil_liq
69           endif
70 1040   CONTINUE
71 1000 CONTINUE
72c
73c Quand l'eau vapeur est trop faible (ou negative), on complete
74c le defaut en prennant de l'eau vapeur de la couche au-dessous.
75c
76      iq = iq_vap
77c
78      DO k = llm, 2, -1
79ccc      zx_abc = dpres(k) / dpres(k-1)
80        DO i = 1, ip1jmp1
81          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
82
83            if (ok_isotopes) then
84              zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
85            endif !if (ok_isotopes) then
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
93c
94c Quand il s'agit de la premiere couche au-dessus du sol, on
95c doit imprimer un message d'avertissement (saturation possible).
96c
97      DO i = 1, ip1jmp1
98         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
99         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
100      ENDDO
101      pompe = SSUM(ip1jmp1,zx_pump,1)
102      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      if (ok_isotopes) 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,ntraciso
134               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
135     :              +zx_defau_diag(i,k,iq_vap)
136     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
137               
138              ! et on la retranche en k-1
139               q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
140     :              -zx_defau_diag(i,k,iq_vap)
141     :              *deltap(i,k)/deltap(i,k-1)
142     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
143
144              enddo !do ixt=1,niso
145              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
146     :               +zx_defau_diag(i,k,iq_vap)
147              q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
148     :               -zx_defau_diag(i,k,iq_vap)
149     :              *deltap(i,k)/deltap(i,k-1)
150          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
151        enddo !DO i = 1, ip1jmp1       
152       enddo !do k=2,llm
153
154        if (ok_iso_verif) then     
155           call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
156        endif !if (ok_iso_verif) then
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,ntraciso
167               q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
168     :              +zx_defau_diag(i,k,iq_liq)
169     :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
170              ! et on la retranche à la vapeur en k
171               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
172     :              -zx_defau_diag(i,k,iq_liq)
173     :              *q(i,k,iqiso(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        if (ok_iso_verif) then
184           call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
185        endif !if (ok_iso_verif) then
186
187      endif !if (ok_isotopes) then
188      !write(*,*) 'qminimum 188'
189     
190c
191      RETURN
192      END
Note: See TracBrowser for help on using the repository browser.